Skip to content

Instantly share code, notes, and snippets.

@wenhuizhang

wenhuizhang/Analog

Created October 16, 2013 19:54
Show Gist options
  • Save wenhuizhang/7013724 to your computer and use it in GitHub Desktop.
Save wenhuizhang/7013724 to your computer and use it in GitHub Desktop.
Download ZIP
2 Photon System Control and Medical Image Analysis_Delphi_Updated till Aug. 2013 (a new version of MPScan)
Raw
Analog
unit analogu;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Menus, ToolWin, ComCtrls, ImgList, ExtCtrls, mpfileu, mpviewu;
type
TAnalogFrm = class(TForm)
StatusBar1: TStatusBar;
MainMenu1: TMainMenu;
Edit1: TMenuItem;
CopytoBitmap1: TMenuItem;
Panel1: TPanel;
ToolBar1: TToolBar;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
ToolButton3: TToolButton;
ToolButton4: TToolButton;
ToolButton5: TToolButton;
ToolButton6: TToolButton;
ImageList1: TImageList;
N1: TMenuItem;
Axes1: TMenuItem;
Frame1: TMenuItem;
GotoFrame1: TMenuItem;
LastFrame1: TMenuItem;
FirstFrame1: TMenuItem;
N3: TMenuItem;
FastReverse1: TMenuItem;
Stop1: TMenuItem;
FastForward1: TMenuItem;
N4: TMenuItem;
PrevFrame1: TMenuItem;
NextFrame1: TMenuItem;
CopyDatatoClipboard1: TMenuItem;
N2: TMenuItem;
NewAnalogChannelsWindow1: TMenuItem;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure FormResize(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure ToolButton2Click(Sender: TObject);
procedure ToolButton3Click(Sender: TObject);
procedure ToolButton4Click(Sender: TObject);
procedure ToolButton5Click(Sender: TObject);
procedure FirstFrame1Click(Sender: TObject);
procedure LastFrame1Click(Sender: TObject);
procedure GotoFrame1Click(Sender: TObject);
procedure CopytoBitmap1Click(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure CopyDatatoClipboard1Click(Sender: TObject);
procedure Axes1Click(Sender: TObject);
procedure NewAnalogChannelsWindow1Click(Sender: TObject);
private
{ Private declarations }
bInitialized: boolean; {prevents events from firing when form is created}
fCurrentFrameIndex: integer;
trace2, trace3: TTrace;
f_MAX_Y_VALUE: integer;
ch2Rect, ch3Rect: TRect;
offscreenBitmap: TBitmap;
function AnalogXToTime(chIndex, sampleIndex: integer): string; {in ms or us}
function AnalogYToValue(chIndex, sampleValue: integer): string; {in units}
procedure DrawBackground;
procedure DrawTraces;
procedure ResizeElements;
procedure SetCurrentFrameIndex(newIndex: integer);
function YToBitmap2(y: integer): integer;
function YToBitmap3(y: integer): integer;
public
{ Public declarations }
mpFile: TMPFile;
yTop2, yTop3, yExtent2, yExtent3: integer;
procedure DrawAnalogData;
procedure OnNewFrame;
procedure Initialize(thempFile: TMPFile);
property CurrentFrameIndex: integer read fCurrentFrameIndex write SetCurrentFrameIndex;
end;
var
AnalogFrm: TAnalogFrm;
implementation
{$R *.DFM}
uses mainfrm, anyaxisu, cpyanaldlgu, clipbrd;
procedure TAnalogFrm.Initialize(thempFile: TMPFile);
var bCaptionOK: boolean;
i, j: integer;
s: string;
begin
mpFile := thempFile;
bCaptionOK := False; i := 0;
f_MAX_Y_VALUE := mpFile.MaxPixelValue;
yTop2 := f_MAX_Y_VALUE; yTop3 := yTop2;
yExtent2 := 2 * (f_MAX_Y_VALUE + 1); yExtent3 := yExtent2;
mpFile.ActiveFrameIndex := fCurrentFrameIndex;
{Sets caption of the form}
while not bCaptionOK do
begin
i := i + 1;
s := ExtractFileName(mpFile.filename) + '; Analog Channels - ' + IntToStr(i);
if mpFile.analogWndList.Count <> 0 then
begin
bCaptionOK := True;
for j := 0 to mpFile.analogWndList.Count - 1 do
if TAnalogFrm(mpFile.analogWndList.Items[j]).Caption = s then
bCaptionOK := False;
end
else
bCaptionOK := True;
end;
Caption := s;
bInitialized := True;
end;
procedure TAnalogFrm.SetCurrentFrameIndex(newIndex: integer);
begin
if (newIndex < 0) or (newIndex >= mpFile.FrameCount) then Exit;
fCurrentFrameIndex := newIndex;
mpFile.ActiveFrameIndex := fCurrentFrameIndex;
OnNewFrame;
end;
function TAnalogFrm.AnalogXToTime(chIndex, sampleIndex: integer): string; {in ms or us}
var dTime: double;
begin
with mpFile do
try
dtime := (sampleIndex / ChDataPtsPerFrame[chIndex] + CurrentFrameIndex) / FrameRate;
if dtime = 0 then
Result := '0 ms'
else if Abs(dtime) > 1E-3 then
Result := Format('%8.3f', [dtime * 1000]) + ' ms'
else
Result := Format('%8.3f', [dtime * 1000000]) + ' ' + Chr(181) + 's';
except
Result := '';
end;
end;
function TAnalogFrm.AnalogYToValue(chIndex, sampleValue: integer): string; {in units}
var dValue: double;
begin
with mpFile do
try
dValue := ChConvFactor[chIndex] * FullScaleToVal(ChInputRange[chIndex]) *
sampleValue / (f_MAX_Y_VALUE + 1) + ChOffset[chIndex];
Result := Format('%8.3g', [dValue]) + ' ' + PrefixToString(ChPrefix[chIndex]) +
ChUnit[chIndex];
except
Result := '';
end;
end;
procedure TAnalogFrm.DrawBackground;
begin
with offscreenBitmap.Canvas, mpFile do
begin
Brush.Color := clBlack;
FillRect(Rect(0, 0, ClientWidth - 1, ClientHeight - StatusBar1.Height - 1));
if AnalogChEnabled[2] and AnalogChEnabled[3] then
begin
Pen.Color := clRed;
MoveTo(ClientWidth div 2, 0);
LineTo(ClientWidth div 2, offscreenBitmap.Height - 1);
end;
end;
end;
procedure TAnalogFrm.DrawTraces;
var i, j, k, l, traceSize: integer;
begin
offscreenBitmap.Canvas.Pen.Color := clWhite;
with mpFile do
begin
if AnalogChEnabled[2] then
begin
traceSize := Length(trace2);
for i := 0 to traceSize - 1 do
begin
j := MulDiv(i, ChDataPtsPerFrame[2] - 1, traceSize - 1);
with mpFile.Frames[CurrentFrameIndex].channels[2] do
begin
trace2[i].MaxPt.y := data[j];
trace2[i].MinPt.y := data[j];
end;
k := MulDiv(i + 1, ChDataPtsPerFrame[2] - 1, traceSize - 1) - 1;
if k >= ChDataPtsPerFrame[2] then k := ChDataPtsPerFrame[2] - 1;
if j < k then
with mpFile.Frames[CurrentFrameIndex].channels[2] do
for l := j + 1 to k do
begin
if data[l] > trace2[i].MaxPt.y then trace2[i].MaxPt.y := data[l];
if data[l] < trace2[i].MinPt.y then trace2[i].MinPt.y := data[l];
end;
trace2[i].MaxPt.y := YToBitmap2(trace2[i].MaxPt.y);
trace2[i].MinPt.y := YToBitmap2(trace2[i].MinPt.y);
end;
Windows.PolyLine(offscreenBitmap.Canvas.Handle, trace2[0].MaxPt, 2 * (traceSize - 1));
end;
if AnalogChEnabled[3] then
begin
traceSize := Length(trace3);
for i := 0 to traceSize - 1 do
begin
j := MulDiv(i, ChDataPtsPerFrame[3] - 1, traceSize - 1);
with mpFile.Frames[CurrentFrameIndex].channels[3] do
begin
trace3[i].MaxPt.y := data[j];
trace3[i].MinPt.y := data[j];
end;
k := MulDiv(i + 1, ChDataPtsPerFrame[3] - 1, traceSize - 1) - 1;
if k >= ChDataPtsPerFrame[3] then k := ChDataPtsPerFrame[3] - 1;
if j < k then
with mpFile.Frames[CurrentFrameIndex].channels[3] do
for l := j + 1 to k do
begin
if data[l] > trace3[i].MaxPt.y then trace3[i].MaxPt.y := data[l];
if data[l] < trace3[i].MinPt.y then trace3[i].MinPt.y := data[l];
end;
trace3[i].MaxPt.y := YToBitmap3(trace3[i].MaxPt.y);
trace3[i].MinPt.y := YToBitmap3(trace3[i].MinPt.y);
end;
Windows.PolyLine(offscreenBitmap.Canvas.Handle, trace3[0].MaxPt, 2 * (traceSize - 1));
end;
end;
end;
procedure TAnalogFrm.ResizeElements;
var i: integer;
begin
offscreenBitmap.Width := ClientWidth;
offscreenBitmap.Height := ClientHeight - StatusBar1.Height - ToolBar1.Height;
with mpFile do
begin
if AnalogChEnabled[2] and not AnalogChEnabled[3] then
begin
ch2Rect := Rect(0, Panel1.Height, ClientWidth - 1,
ClientHeight - StatusBar1.Height {- Panel1.Height} - 1);
SetLength(trace2, ClientWidth);
for i := 0 to ClientWidth - 1 do
begin
trace2[i].MaxPt.x := i;
trace2[i].MinPt.x := i;
end;
end;
if not AnalogChEnabled[2] and AnalogChEnabled[3] then
begin
ch3Rect := Rect(0, Panel1.Height, ClientWidth - 1,
ClientHeight - StatusBar1.Height {- Panel1.Height} - 1);
SetLength(trace3, ClientWidth);
for i := 0 to ClientWidth - 1 do
begin
trace3[i].MaxPt.x := i;
trace3[i].MinPt.x := i;
end;
end;
if AnalogChEnabled[2] and AnalogChEnabled[3] then
begin
ch2Rect := Rect(0, Panel1.Height, ClientWidth div 2 - 1,
ClientHeight - StatusBar1.Height {- Panel1.Height} - 1);
ch3Rect := Rect(ClientWidth div 2 + 1, Panel1.Height, ClientWidth - 1,
ClientHeight - StatusBar1.Height {- Panel1.Height} - 1);
SetLength(trace2, ClientWidth div 2);
for i := 0 to (ClientWidth - 1) div 2 - 1 do
begin
trace2[i].MaxPt.x := i;
trace2[i].MinPt.x := i;
end;
SetLength(trace3, ClientWidth - ClientWidth div 2 - 1);
for i := ClientWidth div 2 + 1 to ClientWidth - 1 do
begin
trace3[i - (ClientWidth div 2 + 1)].MaxPt.x := i;
trace3[i - (ClientWidth div 2 + 1)].MinPt.x := i;
end;
end;
end;
end;
function TAnalogFrm.YToBitmap2(y: integer): integer;
begin
Result := Muldiv(y - yTop2, offscreenBitmap.Height - 1, - yExtent2 + 1);
if Result < 0 then Result := 0;
if Result > offscreenBitmap.Height - 1 then Result := offscreenBitmap.Height - 1;
end;
procedure TAnalogFrm.OnNewFrame;
begin
DrawAnalogData;
StatusBar1.Panels[0].Text := 'Frame: ' + IntToStr(CurrentFrameIndex + 1) +
'/' + IntToStr(mpFile.FrameCount);
end;
function TAnalogFrm.YToBitmap3(y: integer): integer;
begin
Result := Muldiv(y - yTop3, offscreenBitmap.Height - 1, - yExtent3 + 1);
if Result < 0 then Result := 0;
if Result > offscreenBitmap.Height - 1 then Result := offscreenBitmap.Height - 1;
end;
{********************************* PUBLIC *************************************}
procedure TAnalogFrm.DrawAnalogData;
var rc: TRect;
begin
DrawBackground;
DrawTraces;
rc := Rect(0, 0, offscreenBitmap.Width - 1, offscreenBitmap.Height - 1);
Canvas.CopyRect(rc, offscreenBitmap.Canvas,
Rect(rc.Left, rc.Top - ToolBar1.Height, rc.Right, rc.Bottom - ToolBar1.Height));
end;
{****************************** FORM EVENTS ***********************************}
procedure TAnalogFrm.FormCreate(Sender: TObject);
begin
offscreenBitmap := TBitmap.Create;
offscreenBitmap.HandleType := bmDDB;
PrevFrame1.ShortCut := ShortCut(VK_LEFT, []);
NextFrame1.ShortCut := ShortCut(VK_RIGHT, []);
end;
procedure TAnalogFrm.FormShow(Sender: TObject);
begin
if bInitialized then ResizeElements;
end;
procedure TAnalogFrm.FormActivate(Sender: TObject);
begin
with Mainform do
begin
NewFile1.Enabled := True;
OpenFile1.Enabled := True;
if mpFile <> nil then
FileAs1.Enabled := mpFile.IsMemoryFile
else
FileAs1.Enabled := False;
FileInformation1.Enabled := True;
Close1.Enabled := True;
end;
end;
procedure TAnalogFrm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
action := caFree;
if not Mainform.bAppClosing then mpFile.OnWndClose(self);
mpFile := nil;
end;
procedure TAnalogFrm.FormDestroy(Sender: TObject);
begin
offscreenBitmap.Free;
end;
procedure TAnalogFrm.FormPaint(Sender: TObject);
var rc: TRect;
begin
rc := Canvas.ClipRect;
with mpFile do
if AnalogChEnabled[2] or AnalogChEnabled[3] then
begin
DrawBackground;
DrawTraces;
Canvas.CopyRect(rc, offscreenBitmap.Canvas,
Rect(rc.Left, rc.Top - ToolBar1.Height, rc.Right, rc.Bottom - ToolBar1.Height));
end
else
begin
Canvas.Brush.Color := clBlack;
Canvas.FillRect(Rect(0, 0, ClientWidth - 1, ClientHeight - StatusBar1.Height - 1));
end;
end;
procedure TAnalogFrm.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var currentCh: integer;
iX, iY: integer;
begin
currentCh := 3; iX := 0; iY := 0;
with mpFile do
if not AnalogChEnabled[2] and not AnalogChEnabled[3] then Exit;
with mpFile do
begin
if AnalogChEnabled[2] and not AnalogChEnabled[3] then
begin
currentCh := 3;
iX := MulDiv(X, ChDataPtsPerFrame[2] - 1, ch2Rect.Right - ch2Rect.Left);
iY := MulDiv(Y - ch2Rect.Top, - 2 * f_MAX_Y_VALUE - 1, ch2Rect.Bottom - ch2Rect.Top)
+ f_MAX_Y_VALUE;
end;
if not AnalogChEnabled[2] and AnalogChEnabled[3] then
begin
currentCh := 4;
iX := MulDiv(X, ChDataPtsPerFrame[3] - 1, ch3Rect.Right - ch3Rect.Left);
iY := MulDiv(Y - ch3Rect.Top, - 2 * f_MAX_Y_VALUE - 1, ch3Rect.Bottom - ch3Rect.Top)
+ f_MAX_Y_VALUE;
end;
if AnalogChEnabled[2] and AnalogChEnabled[3] then
begin
if X < ClientWidth div 2 then
currentCh := 3
else
begin
currentCh := 4;
X := X - ClientWidth div 2 - 1;
end;
if currentCh = 3 then
begin
iX := MulDiv(X, ChDataPtsPerFrame[2] - 1, ch2Rect.Right - ch2Rect.Left);
iY := MulDiv(Y - ch2Rect.Top, - 2 * f_MAX_Y_VALUE - 1, ch2Rect.Bottom - ch2Rect.Top)
+ f_MAX_Y_VALUE;
end
else
begin
iX := MulDiv(X, ChDataPtsPerFrame[3] - 1, ch3Rect.Right - ch3Rect.Left);
iY := MulDiv(Y - ch3Rect.Top, - 2 * f_MAX_Y_VALUE - 1, ch3Rect.Bottom - ch3Rect.Top)
+ f_MAX_Y_VALUE;
end;
end;
StatusBar1.Panels[1].Text := 'Analog Ch' + IntToStr(currentCh - 2) + ': ' + mpFile.ChNames[currentCh - 1];
StatusBar1.Panels[2].Text := 'T: ' + AnalogXToTime(currentCh - 1 {zero-based}, iX);
StatusBar1.Panels[3].Text := 'Analog: ' + AnalogYToValue(currentCh - 1 {zero-based}, iY);
end;
end;
procedure TAnalogFrm.FormResize(Sender: TObject);
begin
ResizeElements;
Invalidate; {necessary?}
StatusBar1.Panels[0].Text := 'Frame: ' + IntToStr(CurrentFrameIndex + 1) +
'/' + IntToStr(mpFile.FrameCount);
end;
{-------------------------------- MENU EVENTS ---------------------------------}
procedure TAnalogFrm.ToolButton1Click(Sender: TObject);
begin
while (CurrentFrameIndex > 0) and (ToolButton1.Down) do
begin
CurrentFrameIndex := CurrentFrameIndex - 1;
Application.ProcessMessages;
end;
ToolButton1.Down := False;
end;
procedure TAnalogFrm.ToolButton2Click(Sender: TObject);
begin
CurrentFrameIndex := CurrentFrameIndex - 1;
end;
procedure TAnalogFrm.ToolButton3Click(Sender: TObject);
begin
ToolButton1.Down := False;
ToolButton5.Down := False;
end;
procedure TAnalogFrm.ToolButton4Click(Sender: TObject);
begin
CurrentFrameIndex := CurrentFrameIndex + 1;
end;
procedure TAnalogFrm.ToolButton5Click(Sender: TObject);
begin
while (CurrentFrameIndex < mpFile.FrameCount - 1) and (ToolButton5.Down) do
begin
CurrentFrameIndex := CurrentFrameIndex + 1;
Application.ProcessMessages;
end;
ToolButton5.Down := False;
end;
procedure TAnalogFrm.FirstFrame1Click(Sender: TObject);
begin
CurrentFrameIndex := 0;
end;
procedure TAnalogFrm.LastFrame1Click(Sender: TObject);
begin
CurrentFrameIndex := mpFile.FrameCount - 1;
end;
procedure TAnalogFrm.GotoFrame1Click(Sender: TObject);
var s: string;
newFrameIndex: integer;
begin
s := '1';
if InputQuery('Go to Frame', 'Enter Frame Index', s) then
try
newFrameIndex := StrToInt(s);
if (newFrameIndex > 0) and (newFrameIndex <= mpFile.FrameCount) then
CurrentFrameIndex := newFrameIndex - 1
else
MessageDlg('Frame Index Out of Bounds.', mtError, [mbOK], 0);
except
MessageDlg('Invalid Frame Index.', mtError, [mbOK], 0);
end;
end;
procedure TAnalogFrm.CopytoBitmap1Click(Sender: TObject);
begin
with Clipboard do
begin
Open;
Assign(offscreenBitmap);
Close;
end;
end;
procedure TAnalogFrm.CopyDatatoClipboard1Click(Sender: TObject);
var fromFrame, toFrame: integer;
savedCursor: TCursor;
begin
with CopyAnalogDlg do
begin
RadioButton1.Checked := mpFile.AnalogChEnabled[2];
RadioButton1.Enabled := mpFile.AnalogChEnabled[2];
RadioButton2.Checked := mpFile.AnalogChEnabled[3];
RadioButton2.Enabled := mpFile.AnalogChEnabled[3];
SpinEdit1.Value := CurrentFrameIndex + 1;
SpinEdit2.Value := CurrentFrameIndex + 1;
if CopyAnalogDlg.ShowModal = mrOK then
begin
fromFrame := SpinEdit1.Value - 1;
toFrame := SpinEdit2.Value - 1;
if (fromFrame >= 0) and (fromFrame <= mpFile.FrameCount - 1) and
(toFrame >= 0) and (toFrame <= mpFile.FrameCount - 1) and
(fromFrame <= toFrame) then
begin
savedCursor := Screen.Cursor;
try
Screen.Cursor := crHourGlass;
mpFile.CopyChannelsToClipboard(
RadioButton1.Checked and RadioButton1.Enabled,
RadioButton2.Checked and RadioButton2.Enabled,
fromFrame, toFrame);
finally
Screen.Cursor := savedCursor;
end;
end
else
MessageDlg('Invalid frame indices.', mtError, [mbOK], 0);
end;
end;
end;
procedure TAnalogFrm.Axes1Click(Sender: TObject);
var newYTop2, newYExtent2, newYTop3, newYExtent3: integer;
bAccepted: boolean;
begin
newyTop2 := 0;
newyTop3 := 0;
newyExtent2 := 0;
newyExtent3 := 0;
with AnYAxisDlg do
begin
if mpFile.AnalogChEnabled[2] then
begin
PhysUnitEdit1.PhysUnit := mpFile.ChUnit[2];
PhysUnitEdit1.ConvFactor := mpFile.ChConvFactor[2];
PhysUnitEdit1.Prefix := PrefixToExponent(mpFile.ChPrefix[2]);
PhysUnitEdit1.PhysOffset := mpFile.ChOffset[2];
PhysUnitEdit2.PhysUnit := mpFile.ChUnit[2];
PhysUnitEdit2.ConvFactor := mpFile.ChConvFactor[2];
PhysUnitEdit2.Prefix := PrefixToExponent(mpFile.ChPrefix[2]);
PhysUnitEdit2.PhysOffset := mpFile.ChOffset[2];
PhysUnitEdit1.int16Value := yTop2;
PhysUnitEdit2.int16Value := yTop2 - yExtent2 + 1;
end;
if mpFile.AnalogChEnabled[3] then
begin
PhysUnitEdit3.PhysUnit := mpFile.ChUnit[3];
PhysUnitEdit3.ConvFactor := mpFile.ChConvFactor[3];
PhysUnitEdit3.Prefix := PrefixToExponent(mpFile.ChPrefix[3]);
PhysUnitEdit3.PhysOffset := mpFile.ChOffset[3];
PhysUnitEdit4.PhysUnit := mpFile.ChUnit[3];
PhysUnitEdit4.ConvFactor := mpFile.ChConvFactor[3];
PhysUnitEdit4.Prefix := PrefixToExponent(mpFile.ChPrefix[3]);
PhysUnitEdit4.PhysOffset := mpFile.ChOffset[3];
PhysUnitEdit3.int16Value := yTop3;
PhysUnitEdit4.int16Value := yTop3 - yExtent3 + 1;
end;
TabSheet1.Enabled := mpFile.AnalogChEnabled[2];
TabSheet2.Enabled := mpFile.AnalogChEnabled[3];
if not mpFile.AnalogChEnabled[2] then PageControl1.ActivePage := TabSheet2
else PageControl1.ActivePage := TabSheet1;
end;
if AnYAxisDlg.ShowModal = mrOK then
with AnYAxisDlg do
begin
bAccepted := True;
if mpFile.AnalogChEnabled[2] then
begin
newyTop2 := PhysUnitEdit1.int16Value;
newyExtent2 := newyTop2 - PhysUnitEdit2.int16Value + 1;
if (newyTop2 > f_MAX_Y_VALUE) or (newyTop2 < -(f_MAX_Y_VALUE + 1)) or
(newyExtent2 < 10) or (newyExtent2 > 2 * (f_MAX_Y_VALUE + 1)) then
bAccepted := False;
end;
if mpFile.AnalogChEnabled[3] then
begin
newyTop3 := PhysUnitEdit3.int16Value;
newyExtent3 := newyTop3 - PhysUnitEdit4.int16Value + 1;
if (newyTop3 > f_MAX_Y_VALUE) or (newyTop3 < -(f_MAX_Y_VALUE + 1)) or
(newyExtent3 < 10) or (newyExtent3 > 2 * (f_MAX_Y_VALUE + 1)) then
bAccepted := False;
end;
if bAccepted then
begin
yTop2 := newyTop2;
yTop3 := newyTop3;
yExtent2 := newyExtent2;
yExtent3 := newyExtent3;
DrawAnalogData;
end
else
MessageDlg('Invalid Y Axes Values.', mtError, [mbOK], 0);
end;
end;
procedure TAnalogFrm.NewAnalogChannelsWindow1Click(Sender: TObject);
begin
mpFile.NewAnalogWnd;
end;
end.
Raw
Analog Input and Output
unit AVIOptDlgu;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons, Spin, ExtCtrls, MPFileu;
type
TAVIOptDlg = class(TForm)
Label1: TLabel;
SpinEdit1: TSpinEdit;
Label3: TLabel;
SpinEdit2: TSpinEdit;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
Bevel1: TBevel;
Label2: TLabel;
SpinEdit3: TSpinEdit;
Label4: TLabel;
GroupBox1: TGroupBox;
RadioButton1: TRadioButton;
RadioButton3: TRadioButton;
RadioButton2: TRadioButton;
RadioButton4: TRadioButton;
GroupBox2: TGroupBox;
RadioButton5: TRadioButton;
RadioButton6: TRadioButton;
RadioButton7: TRadioButton;
private
{ Private declarations }
public
{ Public declarations }
procedure InitGUI(afile: TMPFile);
function SelectedCh: integer;
end;
var
AVIOptDlg: TAVIOptDlg;
implementation
{$R *.DFM}
procedure TAVIOptDlg.InitGUI(afile: TMPFile);
begin
with afile do
begin
RadioButton1.Checked := (DefaultVideoChannel = 0);
RadioButton2.Checked := (DefaultVideoChannel = 1);
RadioButton3.Checked := (DefaultVideoChannel = 2);
RadioButton4.Checked := (DefaultVideoChannel = 3);
if VideoChCount = 1 then
begin
RadioButton1.Enabled := False;
RadioButton2.Enabled := False;
RadioButton3.Enabled := False;
RadioButton4.Enabled := False;
end
else
begin
RadioButton1.Enabled := ChEnabled[0];
RadioButton2.Enabled := ChEnabled[1];
RadioButton3.Enabled := ChEnabled[2];
RadioButton4.Enabled := ChEnabled[3];
end;
end;
end;
function TAVIOptDlg.SelectedCh: integer;
begin
if RadioButton1.Checked then
Result := 0
else if RadioButton2.Checked then
Result := 1
else if RadioButton3.Checked then
Result := 2
else if RadioButton4.Checked then
Result := 3
else
Result := 0;
end;
end.
Raw
Average Thread
unit Avgthreadu;
interface
uses
Classes, Mainfrm;
type
TAvgThread = class(TThread)
private
procedure UpdateAverage;
protected
procedure Execute; override;
public
constructor Create(CreateSuspended: Boolean);
end;
implementation
{ Important: Methods and properties of objects in VCL can only be used in a
method called using Synchronize, for example,
Synchronize(UpdateCaption);
and UpdateCaption could look like,
procedure TAvgThread.UpdateCaption;
begin
Form1.Caption := 'Updated in a thread';
end; }
{ TAvgThread }
uses AvgFrmu, MPUnit, Windows;
procedure TAvgThread.UpdateAverage;
begin
AvgFrm.BlastFrame;
end;
constructor TAvgThread.Create(CreateSuspended: Boolean);
begin
AvgFrm.curAvgCount := 0;
inherited Create(CreateSuspended);
FreeOnTerminate := True;
end;
procedure TAvgThread.Execute;
var i, j: integer;
begin
{ Place thread code here }
with AvgFrm do
begin
{ ReleaseMutex(avgThreadMutex);} {initializes Mutex}
repeat
{Wait indefinitely for data}
if WaitForSingleObject(avgThreadSemaphore, INFINITE) = WAIT_OBJECT_0 then
{We have data - hold and copy}
if WaitForSingleObject(avgThreadMutex, INFINITE) = WAIT_OBJECT_0 then
if framesDisplayed > lastFrameDisplayed then
begin
for j := 0 to MAX_CH - 1 do
if Mainform.Configuration.VideoChEnabled[j] then
if cbAvgFrameSize[j] > 0 then
System.Move(pTempAvgFrameData[j]^[0],
pLastFrameData[j]^[0], cbAvgFrameSize[j]);
ReleaseMutex(avgThreadMutex);
for j := 0 to MAX_CH - 1 do
if Mainform.Configuration.VideoChEnabled[j] then
if cbAvgFrameSize[j] > 0 then
begin
if (curAvgCount = 0) and (lastFrameDisplayed > 0) then
{zero the averages}
FillChar(pAvgFrameData[j]^, cbAvgFrameSize[j], 0);
for i := 0 to cbAvgFrameSize[j] div SizeOf(int16) - 1 do
pAvgFrameData[j]^[i] := pAvgFrameData[j]^[i] + pLastFrameData[j]^[i];
end;
lastFrameDisplayed := framesDisplayed;
curAvgCount := curAvgCount + 1;
if curAvgCount >= AvgFrm.SpinEdit1.Value then
begin
for j := 0 to MAX_CH - 1 do
if Mainform.Configuration.VideoChEnabled[j] then
if cbAvgFrameSize[j] > 0 then
for i := 0 to cbAvgFrameSize[j] div SizeOf(int16) - 1 do
if Mainform.configuration.PhotonCountingEnabled[j] then
// photon counting will be a sum, not an average
pAvgFrameData[j]^[i] := pAvgFrameData[j]^[i]
else
// analog - use an average
pAvgFrameData[j]^[i] := pAvgFrameData[j]^[i] div curAvgCount;
// note - the display of the values contained in pAvgFrameData happens in
// TAvgfrm.MakeBitmap
Synchronize(UpdateAverage);
curAvgCount := 0;
end;
end
else
ReleaseMutex(avgThreadMutex);
until Terminated or not Mainform.Scanning;
end;
end;
end.
Raw
Axis
unit anyaxisu;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Physuedt, Buttons, ComCtrls;
type
TAnYAxisDlg = class(TForm)
PageControl1: TPageControl;
TabSheet1: TTabSheet;
Label1: TLabel;
Label2: TLabel;
TabSheet2: TTabSheet;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
PhysUnitEdit1: TPhysUnitEdit;
PhysUnitEdit2: TPhysUnitEdit;
Label3: TLabel;
PhysUnitEdit3: TPhysUnitEdit;
Label4: TLabel;
PhysUnitEdit4: TPhysUnitEdit;
private
{ Private declarations }
public
{ Public declarations }
end;
var
AnYAxisDlg: TAnYAxisDlg;
implementation
{$R *.DFM}
end.
Raw
BTN frame
unit binfrm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, Buttons, ComCtrls, Spin;
type
TBinOpForm = class(TForm)
GroupBox1: TGroupBox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
ComboBox1: TComboBox;
SpinEdit1: TSpinEdit;
Edit1: TEdit;
TrackBar1: TTrackBar;
BitBtn1: TBitBtn;
GroupBox2: TGroupBox;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
ComboBox2: TComboBox;
SpinEdit2: TSpinEdit;
Edit2: TEdit;
TrackBar2: TTrackBar;
GroupBox3: TGroupBox;
Label7: TLabel;
ComboBox3: TComboBox;
Label8: TLabel;
Bevel1: TBevel;
Label9: TLabel;
SpeedButton1: TSpeedButton;
BitBtn2: TBitBtn;
RadioButton1: TRadioButton;
RadioButton2: TRadioButton;
RadioButton3: TRadioButton;
RadioButton4: TRadioButton;
RadioButton5: TRadioButton;
RadioButton6: TRadioButton;
RadioButton7: TRadioButton;
RadioButton8: TRadioButton;
procedure BitBtn1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure TrackBar2Change(Sender: TObject);
procedure TrackBar1Change(Sender: TObject);
procedure ComboBox1Change(Sender: TObject);
procedure ComboBox2Change(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
private
{ Private declarations }
function Frames12Compatible: boolean;
function Frames123Compatible: boolean;
public
{ Public declarations }
resultFrameIndex: integer;
end;
var
BinOpForm: TBinOpForm;
implementation
{$R *.DFM}
Uses Mainfrm, MPViewu, MPFileu;
function TBinOpForm.Frames12Compatible: boolean;
var file1, file2: TMPFile;
begin
file1 := TMPFile(ComboBox1.Items.Objects[ComboBox1.ItemIndex]);
file2 := TMPFile(ComboBox2.Items.Objects[ComboBox2.ItemIndex]);
Result := (file1.Resolution = file2.Resolution) and
(file1.FrameWidth = file2.FrameWidth) and
(file1.FrameHeight = file2.FrameHeight);
end;
function TBinOpForm.Frames123Compatible: boolean;
var file1, file2, resultFile: TMPFile;
frame1, frame2: integer;
begin
file1 := TMPFile(ComboBox1.Items.Objects[ComboBox1.ItemIndex]);
file2 := TMPFile(ComboBox2.Items.Objects[ComboBox2.ItemIndex]);
resultFile := TMPFile(ComboBox3.Items.Objects[ComboBox3.ItemIndex]);
frame1 := SpinEdit1.Value - 1;
frame2 := SpinEdit2.Value - 1;
Result := Frames12Compatible and
(resultFrameIndex <> -1) and
// (resultFile.Resolution = file1.Resolution) and
(resultFile.FrameWidth = file1.FrameWidth) and
(resultFile.FrameHeight = file1.FrameHeight) and
(frame1 >= 0) and (frame1 < file1.FrameCount) and
(frame2 >= 0) and (frame2 < file2.FrameCount) and
(resultFrameIndex >= 0) and (resultFrameIndex < resultFile.FrameCount);
end;
procedure TBinOpForm.BitBtn1Click(Sender: TObject);
begin
Close;
end;
procedure TBinOpForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Mainform.bBinaryOp := False;
Action := caFree;
end;
procedure TBinOpForm.FormCreate(Sender: TObject);
var i: integer;
s: string;
begin
resultFrameIndex := -1;
for i := 0 to Mainform.fileList.Count - 1 do
begin
s := Mainform.fileList.Strings[i];
if not TMPFile(Mainform.fileList.Objects[i]).IsMemoryFile then
s := ExtractFileName(s);
ComboBox1.Items.AddObject(s, Mainform.fileList.Objects[i]);
ComboBox2.Items.AddObject(s, Mainform.fileList.Objects[i]);
if TMPFile(Mainform.fileList.Objects[i]).IsMemoryFile then
ComboBox3.Items.AddObject(s, Mainform.fileList.Objects[i]);
end;
ComboBox1.ItemIndex := 0;
ComboBox2.ItemIndex := 0;
ComboBox3.ItemIndex := 0;
end;
procedure TBinOpForm.TrackBar2Change(Sender: TObject);
begin
Edit2.Text := FloatToStr(TrackBar2.Position / 10);
end;
procedure TBinOpForm.TrackBar1Change(Sender: TObject);
begin
Edit1.Text := FloatToStr(TrackBar1.Position / 10);
end;
procedure TBinOpForm.ComboBox1Change(Sender: TObject);
begin
if ComboBox1.ItemIndex >= 0 then
with TMPFile(ComboBox1.Items.Objects[ComboBox1.ItemIndex]) do
begin
RadioButton1.Checked := (DefaultVideoChannel = 0);
RadioButton2.Checked := not (DefaultVideoChannel = 1);
RadioButton5.Checked := not (DefaultVideoChannel = 2);
RadioButton6.Checked := not (DefaultVideoChannel = 3);
if VideoChCount = 1 then
begin
RadioButton1.Enabled := False;
RadioButton2.Enabled := False;
RadioButton5.Enabled := False;
RadioButton6.Enabled := False;
end
else
begin
RadioButton1.Enabled := VideoChEnabled[0];
RadioButton2.Enabled := VideoChEnabled[1];
RadioButton5.Enabled := VideoChEnabled[2];
RadioButton6.Enabled := VideoChEnabled[3];
end;
end;
end;
procedure TBinOpForm.ComboBox2Change(Sender: TObject);
begin
if ComboBox2.ItemIndex >= 0 then
with TMPFile(ComboBox2.Items.Objects[ComboBox2.ItemIndex]) do
begin
RadioButton3.Checked := (DefaultVideoChannel = 0);
RadioButton4.Checked := not (DefaultVideoChannel = 0);
RadioButton7.Checked := not (DefaultVideoChannel = 2);
RadioButton8.Checked := not (DefaultVideoChannel = 3);
if VideoChCount = 1 then
begin
RadioButton3.Enabled := False;
RadioButton4.Enabled := False;
RadioButton7.Enabled := False;
RadioButton8.Enabled := False;
end
else
begin
RadioButton3.Enabled := VideoChEnabled[0];
RadioButton4.Enabled := VideoChEnabled[1];
RadioButton7.Enabled := VideoChEnabled[2];
RadioButton8.Enabled := VideoChEnabled[3];
end;
end;
end;
procedure TBinOpForm.FormShow(Sender: TObject);
begin
ComboBox1Change(nil);
ComboBox2Change(nil);
end;
procedure TBinOpForm.SpeedButton1Click(Sender: TObject);
var resultFile, file1: TMPFile;
begin
resultFile := TMPFile(ComboBox3.Items.Objects[ComboBox3.ItemIndex]);
file1 := TMPFile(ComboBox1.Items.Objects[ComboBox1.ItemIndex]);
{Prerequisitites}
if Frames12Compatible then
begin
ResultFrameIndex := resultFile.CreateEmptyFrame(file1);
Label9.Caption := IntToStr(ResultFrameIndex + 1);
end
else
MessageDlg('Frame 1 and Frame 2 are incompatible.', mtError, [mbOK], 0);
end;
procedure TBinOpForm.BitBtn2Click(Sender: TObject);
var file1, file2, resultFile: TMPFile;
ch1, ch2, frame1, frame2: integer;
gain1, gain2: double;
begin
file1 := TMPFile(ComboBox1.Items.Objects[ComboBox1.ItemIndex]);
file2 := TMPFile(ComboBox2.Items.Objects[ComboBox2.ItemIndex]);
resultFile := TMPFile(ComboBox3.Items.Objects[ComboBox3.ItemIndex]);
frame1 := SpinEdit1.Value - 1;
frame2 := SpinEdit2.Value - 1;
if RadioButton1.Checked then
ch1 := 0
else if RadioButton2.Checked then
ch1 := 1
else if RadioButton5.Checked then
ch1 := 2
else
ch1 := 3;
if RadioButton3.Checked then
ch2 := 0
else if RadioButton4.Checked then
ch2 := 1
else if RadioButton7.Checked then
ch2 := 2
else
ch2 := 3;
gain1 := StrToFloat(Edit1.Text);
gain2 := StrToFloat(Edit2.Text);
if Frames123Compatible then
resultFile.BinaryOp(file1, file2, ch1, ch2, frame1, frame2, gain1, gain2, resultFrameIndex)
else
MessageDlg('Invalid binary operation parameter(s).', mtError, [mbOK], 0);
end;
end.
Raw
CPM
unit cpmdlgu;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Spin, StdCtrls, Buttons;
type
TCopyToMatlabDlg = class(TForm)
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Edit1: TEdit;
RadioButton1: TRadioButton;
Label5: TLabel;
Label6: TLabel;
Edit2: TEdit;
RadioButton2: TRadioButton;
SpinEdit1: TSpinEdit;
SpinEdit2: TSpinEdit;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
private
{ Private declarations }
public
{ Public declarations }
end;
var
CopyToMatlabDlg: TCopyToMatlabDlg;
implementation
{$R *.DFM}
end.
Raw
CPYM
unit cpymdlg;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, Buttons, Spin;
type
TCopymdlg = class(TForm)
Label1: TLabel;
Label2: TLabel;
Label4: TLabel;
Edit1: TEdit;
Edit2: TEdit;
SpinEdit1: TSpinEdit;
SpinEdit2: TSpinEdit;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
Bevel1: TBevel;
RadioButton1: TRadioButton;
RadioButton2: TRadioButton;
Label3: TLabel;
Label5: TLabel;
private
{ Private declarations }
public
{ Public declarations }
end;
var
Copymdlg: TCopymdlg;
implementation
{$R *.DFM}
end.
Raw
DMCCom40u
unit DMCCom40u;
interface
{ Windows interface to Galil Motion Controllers
' For Delphi 5 and higher
' All functions return an error code. 0 is function completed successfully.
' Any error code < 0 is a local error (see the error codes belong).
' Any error code > 0 is an Win32 API error.
' These are documented in the Win32 Programming Reference.
' Constant values
}
const
DMC400 = 'DMC-400';
DMC600 = 'DMC-600';
DMC700 = 'DMC-700';
DMC1000 = 'DMC-1000';
DMC1200 = 'DMC-1200';
DMC1410 = 'DMC-1410';
DMC1411 = 'DMC-1411';
DMC1412 = 'DMC-1412';
DMC1417 = 'DMC-1417';
DMC1500 = 'DMC-1500';
DMC1600 = 'DMC-1600';
DMC1700 = 'DMC-1700';
DMC1800 = 'DMC-1800';
DMC1802 = 'DMC-1802';
DMC2000 = 'DMC-2000';
DMC2100 = 'DMC-2100';
DMC90064 = 'IOC-90064';
// Error Codes
DMCNOERROR = 0;
DMCERROR_TIMEOUT = -1;
DMCERROR_COMMAND = -2;
DMCERROR_CONTROLLER = -3;
DMCERROR_FILE = -4;
DMCERROR_DRIVER = -5 ;
DMCERROR_HANDLE = -6;
DMCERROR_HMODULE = -7;
DMCERROR_MEMORY = -8;
DMCERROR_BUFFERFULL = -9;
DMCERROR_RESPONSEDATA = -10;
DMCERROR_DMA = -11;
DMCERROR_ARGUMENT = -12;
DMCERROR_DATARECORD = -13;
DMCERROR_DOWNLOAD = -14;
DMCERROR_FIRMWARE = -15;
DMCERROR_CONVERSION = -16;
DMCERROR_RESOURCE = -17;
DMCERROR_REGISTRY = -18;
DMCERROR_BUSY = -19;
DMCERROR_DEVICE_DISCONNECTED = -20;
{' IMPORTANT: Constant values for data record item offsets can change between
' firmware revisions. Use the QZ command or the function DMCGetDataRecordRevision
' to determine what revision of data record access you have.
' The DMCGetDataRecordByItemId function retrieves a data record item by unique
' Id while the DMCGetDataRecord function retrieves a data record item by offset.
' While data record item offsets can change with the firmware revision, the data
' record item Ids always remain the same.
' Constant values for data record data types}
DRTypeUnknown = 0;
DRTypeCHAR = 1;
DRTypeUCHAR = 2;
DRTypeSHORT = 3;
DRTypeUSHORT = 4;
DRTypeLONG = 5;
DRTypeULONG = 6;
{' Constant values for data record item Ids to be used with the function
' DMCGetDataRecordByItemId}
DRIdSampleNumber = 1;
DRIdGeneralInput0 = 2;
DRIdGeneralInput1 = 3;
DRIdGeneralInput2 = 4;
DRIdGeneralInput3 = 5;
DRIdGeneralInput4 = 6;
DRIdGeneralInput5 = 7;
DRIdGeneralInput6 = 8;
DRIdGeneralInput7 = 9;
DRIdGeneralInput8 = 10;
DRIdGeneralInput9 = 11;
DRIdGeneralOutput0 = 12;
DRIdGeneralOutput1 = 13;
DRIdGeneralOutput2 = 14;
DRIdGeneralOutput3 = 15;
DRIdGeneralOutput4 = 16;
DRIdGeneralOutput5 = 17;
DRIdGeneralOutput6 = 18;
DRIdGeneralOutput7 = 19;
DRIdGeneralOutput8 = 20;
DRIdGeneralOutput9 = 21;
DRIdErrorCode = 22;
DRIdGeneralStatus = 23;
DRIdSegmentCountS = 24;
DRIdCoordinatedMoveStatusS = 25;
DRIdCoordinatedMoveDistanceS = 26;
DRIdSegmentCountT = 27;
DRIdCoordinatedMoveStatusT = 28;
DRIdCoordinatedMoveDistanceT = 29;
DRIdAnalogInput1 = 30;
DRIdAnalogInput2 = 31;
DRIdAnalogInput3 = 32;
DRIdAnalogInput4 = 33;
DRIdAnalogInput5 = 34;
DRIdAnalogInput6 = 35;
DRIdAnalogInput7 = 36;
DRIdAnalogInput8 = 37;
DRIdAxisStatus = 38;
DRIdAxisSwitches = 39;
DRIdAxisStopCode = 40;
DRIdAxisReferencePosition = 41;
DRIdAxisMotorPosition = 42;
DRIdAxisPositionError = 43;
DRIdAxisAuxillaryPosition = 44 ;
DRIdAxisVelocity = 45;
DRIdAxisTorque = 46;
DRIdSlotModulePresent = 47;
DRIdSlotModuleType = 48;
DRIdSlotNumberOfIOPoints = 49;
DRIdSlotIODirection = 50;
DRIdSlotAnalogRange = 51;
DRIdSlotRangeType = 52;
DRIdSlotIOData0 = 53;
DRIdSlotIOData1 = 54;
DRIdSlotIOData2 = 55;
DRIdSlotIOData3 = 56;
DRIdSlotIOData4 = 57;
DRIdSlotIOData5 = 58;
DRIdSlotIOData6 = 59;
DRIdSlotIOData7 = 60;
{' Constant values for axis Ids to be used with the function
' DMCGetDataRecordByItemId}
DRIdAxis1 = 1;
DRIdAxis2 = 2;
DRIdAxis3 = 3;
DRIdAxis4 = 4;
DRIdAxis5 = 5;
DRIdAxis6 = 6;
DRIdAxis7 = 7;
DRIdAxis8 = 8;
{'Constant values for IOC7007 slot Ids to be used with the function
'DMCGetDataRecordByItemId
'DMCGetDataRecordSlotIDs}
DRIdSlot1 = 15;
DRIdSlot2 = 16;
DRIdSlot3 = 17;
DRIdSlot4 = 18;
DRIdSlot5 = 19;
DRIdSlot6 = 20;
DRIdSlot7 = 21;
{' Data record offsets
' Rev 1 constants
' QZ command returns <#axes>,12,6,26
' Rev 2 constants
' QZ command returns <#axes>,26,6,26
' This rev added items to the general section for extended I/O.
' Rev 3 constants
' QZ command returns <#axes>,24,16,26
' This rev added items to the general section for the coordinated motion T axis.
' Rev 4 constants
' QZ command returns <#axes>,24,16,28
' This rev added 1 item to the axis section for analog inputs.
' Note: each axis will now include the current value for 1 analog input.
' X axis - analog 1, Y axis - analog 2, and so on. You must have an 8 axis
' controller to get data for all 8 analog inputs.
' Rev 5 constants
' QZ command returns 0,8,0,0
' This rev added to accomodate the IOC-90064.
' Note: this card's data record is much smaller compared
' to previous revisions. The sample number, error
' code, general status, and 8 general inputs and 8 general
' outputs are supported.
'Rev 6 constants
'STA: Revision added 11/13/01 to support the IOC-7007
'QZ command returns 7,4,0,22
' Rev 1 General data item offsets}
REV1GenOffSampleNumber = 0;
REV1GenOffGeneralInput1 = 2;
REV1GenOffGeneralInput2 = 3 ;
REV1GenOffGeneralInput3 = 4 ;
REV1GenOffSpare = 5 ;
REV1GenOffGeneralOutput1 = 6 ;
REV1GenOffGeneralOutput2 = 7 ;
REV1GenOffErrorCode = 8 ;
REV1GenOffGeneralStatus = 9 ;
REV1GenOffSegmentCount = 10 ;
REV1GenOffCoordinatedMoveStatus = 12;
REV1GenOffCoordinatedMoveDistance = 14;
REV1GenOffAxis1 = 18 ;
REV1GenOffAxis2 = 44 ;
REV1GenOffAxis3 = 70 ;
REV1GenOffAxis4 = 96 ;
REV1GenOffAxis5 = 122 ;
REV1GenOffAxis6 = 148 ;
REV1GenOffAxis7 = 174 ;
REV1GenOffAxis8 = 200 ;
REV1GenOffEnd = 226 ;
{' Rev 1 axis data item offsets}
REV1AxisOffNoAxis = 0;
REV1AxisOffAxisStatus = 0;
REV1AxisOffAxisSwitches = 2;
REV1AxisOffAxisStopCode = 3;
REV1AxisOffAxisReferencePosition = 4;
REV1AxisOffAxisMotorPosition = 8;
REV1AxisOffAxisPositionError = 12;
REV1AxisOffAxisAuxillaryPosition = 16;
REV1AxisOffAxisVelocity = 20;
REV1AxisOffAxisTorque = 24;
REV1AxisOffEnd = 26;
{' Rev 2 General data item offsets}
REV2GenOffSampleNumber = 0;
REV2GenOffGeneralInput0 = 2;
REV2GenOffGeneralInput1 = 3;
REV2GenOffGeneralInput2 = 4;
REV2GenOffGeneralInput3 = 5;
REV2GenOffGeneralInput4 = 6;
REV2GenOffGeneralInput5 = 7;
REV2GenOffGeneralInput6 = 8;
REV2GenOffGeneralInput7 = 9;
REV2GenOffGeneralInput8 = 10;
REV2GenOffGeneralInput9 = 11;
REV2GenOffGeneralOutput0 = 12;
REV2GenOffGeneralOutput1 = 13;
REV2GenOffGeneralOutput2 = 14;
REV2GenOffGeneralOutput3 = 15;
REV2GenOffGeneralOutput4 = 16;
REV2GenOffGeneralOutput5 = 17;
REV2GenOffGeneralOutput6 = 18;
REV2GenOffGeneralOutput7 = 19;
REV2GenOffGeneralOutput8 = 20;
REV2GenOffGeneralOutput9 = 21;
REV2GenOffErrorCode = 22;
REV2GenOffGeneralStatus = 23;
REV2GenOffSegmentCount = 24;
REV2GenOffCoordinatedMoveStatus = 26;
REV2GenOffCoordinatedMoveDistance = 28;
REV2GenOffAxis1 = 32;
REV2GenOffAxis2 = 58;
REV2GenOffAxis3 = 84;
REV2GenOffAxis4 = 110;
REV2GenOffAxis5 = 136;
REV2GenOffAxis6 = 162;
REV2GenOffAxis7 = 188;
REV2GenOffAxis8 = 214;
REV2GenOffEnd = 240;
{' Rev 2 axis data item offsets }
REV2AxisOffNoAxis = 0;
REV2AxisOffAxisStatus = 0;
REV2AxisOffAxisSwitches = 2;
REV2AxisOffAxisStopCode = 3;
REV2AxisOffAxisReferencePosition = 4;
REV2AxisOffAxisMotorPosition = 8;
REV2AxisOffAxisPositionError = 12;
REV2AxisOffAxisAuxillaryPosition = 16;
REV2AxisOffAxisVelocity = 20;
REV2AxisOffAxisTorque = 24;
REV2AxisOffEnd = 26;
{' Rev 3 General data item offsets}
REV3GenOffSampleNumber = 0;
REV3GenOffGeneralInput0 = 2;
REV3GenOffGeneralInput1 = 3;
REV3GenOffGeneralInput2 = 4;
REV3GenOffGeneralInput3 = 5;
REV3GenOffGeneralInput4 = 6;
REV3GenOffGeneralInput5 = 7;
REV3GenOffGeneralInput6 = 8;
REV3GenOffGeneralInput7 = 9;
REV3GenOffGeneralInput8 = 10;
REV3GenOffGeneralInput9 = 11;
REV3GenOffGeneralOutput0 = 12;
REV3GenOffGeneralOutput1 = 13;
REV3GenOffGeneralOutput2 = 14;
REV3GenOffGeneralOutput3 = 15;
REV3GenOffGeneralOutput4 = 16;
REV3GenOffGeneralOutput5 = 17;
REV3GenOffGeneralOutput6 = 18;
REV3GenOffGeneralOutput7 = 19;
REV3GenOffGeneralOutput8 = 20;
REV3GenOffGeneralOutput9 = 21;
REV3GenOffErrorCode = 22;
REV3GenOffGeneralStatus = 23;
REV3GenOffSegmentCountS = 24;
REV3GenOffCoordinatedMoveStatusS = 26;
REV3GenOffCoordinatedMoveDistanceS = 28;
REV3GenOffSegmentCountT = 32;
REV3GenOffCoordinatedMoveStatusT = 34;
REV3GenOffCoordinatedMoveDistanceT = 36;
REV3GenOffAxis1 = 40;
REV3GenOffAxis2 = 66;
REV3GenOffAxis3 = 92;
REV3GenOffAxis4 = 118;
REV3GenOffAxis5 = 144;
REV3GenOffAxis6 = 170;
REV3GenOffAxis7 = 196;
REV3GenOffAxis8 = 222;
REV3GenOffEnd = 248;
{' Rev 3 axis data item offsets}
REV3AxisOffNoAxis = 0;
REV3AxisOffAxisStatus = 0;
REV3AxisOffAxisSwitches = 2;
REV3AxisOffAxisStopCode = 3;
REV3AxisOffAxisReferencePosition = 4;
REV3AxisOffAxisMotorPosition = 8;
REV3AxisOffAxisPositionError = 12;
REV3AxisOffAxisAuxillaryPosition = 16;
REV3AxisOffAxisVelocity = 20;
REV3AxisOffAxisTorque = 24;
REV3AxisOffEnd = 26;
{' Rev 4 General data item offsets}
REV4GenOffSampleNumber = 0;
REV4GenOffGeneralInput0 = 2;
REV4GenOffGeneralInput1 = 3;
REV4GenOffGeneralInput2 = 4;
REV4GenOffGeneralInput3 = 5;
REV4GenOffGeneralInput4 = 6;
REV4GenOffGeneralInput5 = 7;
REV4GenOffGeneralInput6 = 8;
REV4GenOffGeneralInput7 = 9;
REV4GenOffGeneralInput8 = 10;
REV4GenOffGeneralInput9 = 11;
REV4GenOffGeneralOutput0 = 12;
REV4GenOffGeneralOutput1 = 13;
REV4GenOffGeneralOutput2 = 14;
REV4GenOffGeneralOutput3 = 15;
REV4GenOffGeneralOutput4 = 16;
REV4GenOffGeneralOutput5 = 17;
REV4GenOffGeneralOutput6 = 18;
REV4GenOffGeneralOutput7 = 19;
REV4GenOffGeneralOutput8 = 20;
REV4GenOffGeneralOutput9 = 21;
REV4GenOffErrorCode = 22;
REV4GenOffGeneralStatus = 23;
REV4GenOffSegmentCountS = 24;
REV4GenOffCoordinatedMoveStatusS = 26;
REV4GenOffCoordinatedMoveDistanceS = 28;
REV4GenOffSegmentCountT = 32;
REV4GenOffCoordinatedMoveStatusT = 34;
REV4GenOffCoordinatedMoveDistanceT = 36;
REV4GenOffAxis1 = 40;
REV4GenOffAxis2 = 68;
REV4GenOffAxis3 = 96;
REV4GenOffAxis4 = 124;
REV4GenOffAxis5 = 152;
REV4GenOffAxis6 = 180;
REV4GenOffAxis7 = 208;
REV4GenOffAxis8 = 236;
REV4GenOffEnd = 264;
//' Rev 4 axis data item offsets
REV4AxisOffNoAxis = 0;
REV4AxisOffAxisStatus = 0;
REV4AxisOffAxisSwitches = 2;
REV4AxisOffAxisStopCode = 3;
REV4AxisOffAxisReferencePosition = 4;
REV4AxisOffAxisMotorPosition = 8;
REV4AxisOffAxisPositionError = 12;
REV4AxisOffAxisAuxillaryPosition = 16;
REV4AxisOffAxisVelocity = 20;
REV4AxisOffAxisTorque = 24;
REV4AxisOffAnalogInput = 26;
REV4AxisOffEnd = 28 ;
//' Rev 5 General data item offsets
DRREV5GenOffSampleNumber = 0;
DRREV5GenOffConfigByte = 2;
DRREV5GenOffGeneralIO0 = 3;
DRREV5GenOffGeneralIO1 = 4;
DRREV5GenOffGeneralIO2 = 5;
DRREV5GenOffGeneralIO3 = 6;
DRREV5GenOffGeneralIO4 = 7;
DRREV5GenOffGeneralIO5 = 8;
DRREV5GenOffGeneralIO6 = 9;
DRREV5GenOffGeneralIO7 = 10;
DRREV5GenOffErrorCode = 11;
DRREV5GenOffGeneralStatus = 12;
//' Rev 6 General data item offsets
DRREV6GenOffsetSampleNumber = 0;
DRREV6GenOffsetErrorCode = 2;
DRREV6GenOffsetGeneralStatus = 3;
DRREV6GenOffsetSlot1 = 4;
DRREV6GenOffsetSlot2 = 26;
DRREV6GenOffsetSlot3 = 48;
DRREV6GenOffsetSlot4 = 70;
DRREV6GenOffsetSlot5 = 92;
DRREV6GenOffsetSlot6 = 11;
DRREV6GenOffsetSlot7 = 136;
DRREV6GenOffsetEnd = 158;
{' Rev 6 slot data item offsets
' Slots on the IOC7007 are analagous to axis on controllers for the purpose of
' data records}
DRREV6SlotOffsetModulePresent = 0;
DRREV6SlotOffsetDigitalOrAnalogBitCount = 1;
DRREV6SlotOffsetNumIOPoints = 2;
DRREV6SlotOffsetDirection = 3;
DRREV6SlotOffsetRange = 4;
DRREV6SlotOffsetRangeType = 5;
DRREV6SlotOffsetIOData0 = 6;
DRREV6SlotOffsetIOData1 = 8;
DRREV6SlotOffsetIOData2 = 10;
DRREV6SlotOffsetIOData3 = 12;
DRREV6SlotOffsetIOData4 = 14;
DRREV6SlotOffsetIOData5 = 16;
DRREV6SlotOffsetIOData6 = 18;
DRREV6SlotOffsetIOData7 = 20;
DRREV6SlotOffsetEnd = 22;
{' ** The following constants are OBSOLETE **
' General offsets for firmware without coordinated motion T axis - data record revsion 2}
DRGenOffsetsSampleNumber = 0;
DRGenOffsetsGeneralInput0 = 2;
DRGenOffsetsGeneralInput1 = 3;
DRGenOffsetsGeneralInput2 = 4;
DRGenOffsetsGeneralInput3 = 5;
DRGenOffsetsGeneralInput4 = 6;
DRGenOffsetsGeneralInput5 = 7;
DRGenOffsetsGeneralInput6 = 8;
DRGenOffsetsGeneralInput7 = 9;
DRGenOffsetsGeneralInput8 = 10;
DRGenOffsetsGeneralInput9 = 11;
DRGenOffsetsGeneralOutput0 = 12;
DRGenOffsetsGeneralOutput1 = 13;
DRGenOffsetsGeneralOutput2 = 14;
DRGenOffsetsGeneralOutput3 = 15;
DRGenOffsetsGeneralOutput4 = 16;
DRGenOffsetsGeneralOutput5 = 17;
DRGenOffsetsGeneralOutput6 = 18;
DRGenOffsetsGeneralOutput7 = 19;
DRGenOffsetsGeneralOutput8 = 20;
DRGenOffsetsGeneralOutput9 = 21;
DRGenOffsetsErrorCode = 22;
DRGenOffsetsGeneralStatus = 23;
DRGenOffsetsSegmentCount = 24;
DRGenOffsetsCoordinatedMoveStatus = 26;
DRGenOffsetsCoordinatedMoveDistance = 28;
DRGenOffsetsAxis1 = 32;
DRGenOffsetsAxis2 = 58;
DRGenOffsetsAxis3 = 84;
DRGenOffsetsAxis4 = 110;
DRGenOffsetsAxis5 = 136;
DRGenOffsetsAxis6 = 162;
DRGenOffsetsAxis7 = 188;
DRGenOffsetsAxis8 = 214;
DRGenOffsetsEnd = 240;
{' ** The following constants are OBSOLETE **
' General offsets for firmware with coordinated motion T axis - data record revsion 3}
wTDRGenOffsetsSampleNumber = 0;
wTDRGenOffsetsGeneralInput0 = 2;
wTDRGenOffsetsGeneralInput1 = 3;
wTDRGenOffsetsGeneralInput2 = 4;
wTDRGenOffsetsGeneralInput3 = 5;
wTDRGenOffsetsGeneralInput4 = 6;
wTDRGenOffsetsGeneralInput5 = 7;
wTDRGenOffsetsGeneralInput6 = 8;
wTDRGenOffsetsGeneralInput7 = 9;
wTDRGenOffsetsGeneralInput8 = 10;
wTDRGenOffsetsGeneralInput9 = 11;
wTDRGenOffsetsGeneralOutput0 = 12;
wTDRGenOffsetsGeneralOutput1 = 13;
wTDRGenOffsetsGeneralOutput2 = 14;
wTDRGenOffsetsGeneralOutput3 = 15;
wTDRGenOffsetsGeneralOutput4 = 16;
wTDRGenOffsetsGeneralOutput5 = 17;
wTDRGenOffsetsGeneralOutput6 = 18;
wTDRGenOffsetsGeneralOutput7 = 19;
wTDRGenOffsetsGeneralOutput8 = 20;
wTDRGenOffsetsGeneralOutput9 = 21;
wTDRGenOffsetsErrorCode = 22;
wTDRGenOffsetsGeneralStatus = 23;
wTDRGenOffsetsSegmentCountS = 24;
wTDRGenOffsetsCoordinatedMoveStatusS = 26;
wTDRGenOffsetsCoordinatedMoveDistanceS = 28;
wTDRGenOffsetsSegmentCountT = 32;
wTDRGenOffsetsCoordinatedMoveStatusT = 34;
wTDRGenOffsetsCoordinatedMoveDistanceT = 36;
wTDRGenOffsetsAxis1 = 40;
wTDRGenOffsetsAxis2 = 66;
wTDRGenOffsetsAxis3 = 92;
wTDRGenOffsetsAxis4 = 118;
wTDRGenOffsetsAxis5 = 144;
wTDRGenOffsetsAxis6 = 170;
wTDRGenOffsetsAxis7 = 196;
wTDRGenOffsetsAxis8 = 222;
wTDRGenOffsetsEnd = 248;
{' Constant values for data record axis data item offsets
' IMPORTANT - Values can change between revisions}
DRAxisOffsetsNoAxis = 0;
DRAxisOffsetsAxisStatus = 0;
DRAxisOffsetsAxisSwitches = 2;
DRAxisOffsetsAxisStopCode = 3;
DRAxisOffsetsAxisReferencePosition = 4;
DRAxisOffsetsAxisMotorPosition = 8;
DRAxisOffsetsAxisPositionError = 12;
DRAxisOffsetsAxisAuxillaryPosition = 16;
DRAxisOffsetsAxisVelocity = 20;
DRAxisOffsetsAxisTorque = 24;
DRAxisOffsetsEnd = 26;
//' Constant values for GALILREGISTRY structure
//' Controller Type
ControllerTypeISABus = 0;
ControllerTypeSerial = 1;
ControllerTypePCIBus = 2;
ControllerTypeUSB = 3;
//' Device Drivers
DeviceDriverWinRT = 0;
DeviceDriverGalil = 1;
//' Serial Handshake
SerialHandshakeHardware = 0;
SerialHandshakeSoftware = 1;
//' Data Record Access
DataRecordAccessNone = 0 ;
DataRecordAccessDMA = 1;
DataRecordAccessFIFO = 2 ;
//' Ethernet Protocol
EthernetProtocolTCP = 0;
EthernetProtocolUDP = 1;
//' Structures
//' To add/change/delete registry information
type
GALILREGISTRY = record
Model: array[0..15]of Char;
DeviceNumber,
DeviceDriver,
Timeout,
Delay,
ControllerType,
CommPort,
CommSpeed,
Handshake,
Address,
iinterrupt,
DataRecordAccess,
DMAChannel,
DataRecordSize,
RefreshRate,
SerialNumber: integer;
PNPHardwareKey: array[0..63] of Char;
end;
// Function prototypes
TDMCOpen = function(Controller, hWnd: integer; var phDmc: integer): integer; stdcall;
{' Open communications with the Galil controller.
' Controller A number between 1 and 16. Up to 16 Galil controllers may be
' addressed per process.
' hWnd The window handle to use for notifying the application
' program of an interrupt.
' phDmc Handle to the Galil controller to be use for all subsequent
' API calls.}
TDMCOpen2 = function(Controller, ThreadID: integer; var phDmc: integer): integer; stdcall;
{' Open communications with the Galil controller.
' Controller A number between 1 and 16. Up to 16 Galil controllers may be
' addressed per process.
' ThreadID The thread id to use for notifying the application
' program of an interrupt.
' phDmc Handle to the Galil controller to be use for all subsequent
' API calls.}
TDMCGetHandle = function(Controller: integer; var phDmc: integer): integer; stdcall;
{' Get the handle associated with a particular Galil controller.
' Controller A number between 1 and 16. Up to 16 Galil controllers may be
' addressed per process.
' phDmc Handle to the Galil controller to be use for all subsequent
' API calls.}
TDMCClose = function(hDmc: integer): integer; stdcall;
{' Close communications with the Galil controller.
' hDmc Handle to the Galil controller. }
TDMCCommand = function(hDmc : integer; CommandString, Response: PChar; ResponseLength: integer): integer; stdcall;
{' Send a command to the Galil controller.
' NOTE: This function can only send commands or groups of commands up to
' 1024 bytes long.
' hDmc Handle to the Galil controller.
' CommandString The command to send to the Galil controller.
' Response Buffer to receive the response data.
' ResponseLength Length of the buffer.}
TDMCFastCommand = function(hDmc: integer; CommandString: PChar): integer; stdcall;
{' Send a command to the Galil controller without the overhead of waiting for a response. Use this function with
' caution as command errors will not be reported and the out-going FIFO or communciations buffer
' may fill up. This function is intended to be used in routines which provide data records for the Galil
' DL and QD commands which do not return a response. Other uses may be to send contour data.
' NOTE: This function can only send commands or groups of commands up to
' 1024 bytes long.
' hDmc Handle to the Galil controller.
' CommandString The command to send to the Galil controller.}
TDMCGetUnsolicitedResponse = function(hDmc: integer; Response: PChar; ResponseLength: integer): integer; stdcall;
{' Query the Galil controller for unsolicited responses. These are messages
' output from programs running in the background in the Galil controller.
' hDmc Handle to the Galil controller.
' Response Buffer to receive the response data.
' ResponseLength Length of the buffer.
}
TDMCWriteData = function(hDmc: integer; Buffer: PChar; BufferLength: integer; var BytesWritten: integer): integer; stdcall;
{' Low-level I/O routine to write data to the Galil controller. Data is written
' to the Galil controller only if it is "ready" to receive it. The function
' will attempt to write exactly cbBuffer characters to the controller.
' NOTE: For Win32 and WinRT driver the maximum number of bytes which can be written
' each time is 64. There are no restrictions with the Galil driver.
' hDmc Handle to the Galil controller.
' Buffer Buffer to write the data from. Data does not need to be
' NULL terminated.
' BufferLength Length of the data in the buffer.
' BytesWritten Number of bytes written.
}
TDMCReadData = function(hDmc: integer; Buffer: PChar; BufferLength: integer; var BytesRead: integer): integer; stdcall;
{' Low-level I/O routine to read data from the Galil controller. The routine
' will read what ever is currently in the FIFO (bus controller) or
' communications port input queue (serial controller). The function will read
' up to cbBuffer characters from the controller. The data placed in the user
' buffer (pchBuffer) is NOT NULL terminated. The data returned is not guaranteed
' to be a complete response - you may have to call this function repeatedly to
' get a complete response.
' NOTE: For Win32 and WinRT driver the maximum number of bytes which can be read
' each time is 64. There are no restrictions with the Galil driver.
' hDmc Handle to the Galil controller.
' Buffer Buffer to read the data into. Data will not be NULL
' terminated.
' BufferLength Length of the buffer.
' BytesRead Number of bytes read.}
TDMCGetAdditionalResponseLen = function(hDmc: integer; var ResponseLength: integer): integer; stdcall;
{' Query the Galil controller for the length of the additional response data. There will be more
' response data available if DMCCommand returned DMCERROR_BUFFERFULL.
' hDmc Handle to the Galil controller.
' ResponseLength Length of the additional response data.
}
TDMCGetAdditionalResponse = function(hDmc: integer; Response: PChar; ResponseLength: integer): integer; stdcall;
{' Query the Galil controller for more response data. There will be more
' response data available if DMCCommand returned DMCERROR_BUFFERFULL.
' hDmc Handle to the Galil controller.
' Response Buffer to receive the response data.
' ResponseLength Length of the buffer.
}
TDMCError = function(hDmc: integer; var ErrorCode: integer; var sMessage: WideChar; var MessageLength: integer): integer; stdcall;
{' Retrieve the error message text from a DMCERROR_COMMAND error.
' hDmc Handle to the Galil controller.
' ErrorCode Error returned from API function.
' Message Buffer to receive the error message text.
' MessageLength Length of the buffer.
}
TDMCClear = function(hDmc: integer): integer; stdcall;
{' Clear the Galil controller FIFO.
' hDmc Handle to the Galil controller.}
TDMCReset = function(hDmc: integer): integer; stdcall;
{' Reset the Galil controller.
' hDmc Handle to the Galil controller.
}
TDMCMasterReset = function(hDmc: integer): integer; stdcall;
{' Master reset the Galil controller.
' hDmc Handle to the Galil controller.
}
TDMCVersion = function(hDmc: integer; Version : PChar; VersionLength: integer): integer; stdcall;
{' Get the version of the Galil controller.
' hDmc Handle to the Galil controller.
' Version Buffer to receive the version information.
' VersionLength Length of the buffer.
}
TDMCDownloadFile = function(hDmc: integer; FileName, sLabel: PChar): integer; stdcall;
{' Download a file to the Galil controller.
' hDmc Handle to the Galil controller.
' FileName File name to download to the Galil controller.
' Label Program label to download to. This argument is ignored if
' NULL.
}
{
Public Declare Function DMCDownloadFromBuffer = function ( hDmc As Long, Buffer : PChar;, Label : PChar;) As Long
' Download a file to the Galil controller.
' hDmc Handle to the Galil controller.
' Buffer Buffer of DMC commands to download to the Galil controller.
' Label Program label to download to. This argument is ignored if
' NULL.
Public Declare Function DMCUploadFile = function ( hDmc As Long, FileName : PChar;) As Long
' Upload a file from the Galil controller.
' FileName File name to upload from the Galil controller.
Public Declare Function DMCUploadToBuffer = function ( hDmc As Long, Buffer : PChar;, BufferLength As Long) As Long
' Upload a file from the Galil controller.
' Buffer Buffer of DMC commands to upload from the Galil controller.
' BufferLength Length of the buffer.
Public Declare Function DMCSendFile = function ( hDmc As Long, FileName : PChar;) As Long
' Send a file to the Galil controller.
' hDmc Handle to the Galil controller.
' FileName File name to send to the Galil controller.
Public Declare Function DMCArrayDownload = function ( hDmc As Long, ArrayName : PChar;, FirstElement : integer; , LastElement : integer; , Data : PChar;, DataLength As Long, BytesWritten As Long) As Long
' Download an array to the Galil controller. The array must exist. Array data can be
' delimited by a comma or CR (0x0D) or CR/LF (0x0D0A).
' NOTE: The firmware on the controller must be recent enough to support the QD command.
' hDmc Handle to the Galil controller.
' ArrayName Array name to download to the Galil controller.
' FirstElement First array element.
' LastElement Last array element.
' Data Buffer to write the array data from. Data does not need to be
' NULL terminated.
' DataLength Length of the array data in the buffer.
' BytesWritten Number of bytes written.
Public Declare Function DMCArrayUpload = function ( hDmc : integer;, ArrayName : PChar;, FirstElement : integer; , LastElement : integer; , Buffer : PChar;, BufferLength : integer;, BytesRead : integer;, Comma : integer; ) : integer;
' Upload an array from the Galil controller. The array must exist. Array data will be
' delimited by a comma or CR (0x0D) depending of the value of fComma.
' NOTE: The firmware on the controller must be recent enough to support the QU command.
' hDmc Handle to the Galil controller.
' ArrayName Array name to upload from the Galil controller.
' FirstElement First array element.
' LastElement Last array element.
' Buffer Buffer to read the array data into. Array data will not be
' NULL terminated.
' BufferLength Length of the buffer.
' BytesRead Number of bytes read.
}
TDMCRefreshDataRecord = function ( hDmc : integer; Length : integer) : integer; stdcall;
{' Refresh the data record used for fast polling.
' hDmc Handle to the Galil controller.
' Length Refresh size in bytes. Set to 0 unless you do not want a full-buffer
' refresh. }
TDMCGetDataRecord = function ( hDmc : integer; GeneralOffset : integer; AxisInfoOffset : integer; DataType : integer; Data : integer) : integer; stdcall;
{' Get a data item from the data record used for fast polling. Gets one item from the
' data record by using offsets. To retrieve data record items by Id instead of offset,
' use the function DMCGetDataRecordByItemId.
' hDmc Handle to the Galil controller.
' GeneralOffset Data record offset for general data item.
' AxisInfoOffset Additional data record offset for axis data item.
' DataType Data type of the data item. If you are using the standard,
' pre-defined offsets, set this argument to zero before calling this
' function. The actual data type of the data item is returned on output.
' Data Buffer to receive the data record data. Output only.}
TDMCGetDataRecordByItemId = function (hDmc, ItemId, AxisId, DataType, Data : integer) : integer; stdcall;
{' Get a data item from the data record used for fast polling. Gets one item from the
' data record by using Id. To retrieve data record items by offset instead of Id,
' use the function DMCGetDataRecord.
' hDmc Handle to the Galil controller.
' ItemId Data record item Id.
' AxisId Axis Id used for axis data items.
' DataType Data type of the data item. The data type of the
' data item is returned on output. Output Only.
' Data Buffer to receive the data record data. Output only.}
TDMCGetDataRecordRevision = function (hDmc, Revision : integer) : integer; stdcall;
{' Get the revision of the data record structure used for fast polling.
' hDmc Handle to the Galil controller.
' Revision The revision of the data record structure is returned on
' output. Output Only.}
{ TDMCDiagnosticsOn = function ( hDmc : integer;, FileName : PChar;, AppendFile : integer; ) : integer;
' Turn on diagnostics.
' hDmc Handle to the Galil controller.
' FileName File name for the diagnostic file.
' AppendFile True if the file will open for append, otherwise False.
TDMCDiagnosticsOff = function ( hDmc : integer;) : integer;
' Turn off diagnostics.
' hDmc Handle to the Galil controller. }
TDMCGetTimeout = function (hDmc : integer; Timeout : integer) : integer; stdcall;
{ Get current timeout value.
' hDmc Handle to the Galil controller.
' Timeout Current timeout value in milliseconds.
}
TDMCSetTimeout = function (hDmc : integer; Timeout : integer) : integer; stdcall;
{Set timeout value.
' hDmc Handle to the Galil controller.
' Timeout Timeout value in milliseconds.
}
{TDMCGetDelay = function ( hDmc : integer;, Delay : integer;) : integer;
' Get current delay value.
' *** THIS FUNCTION IS OBSOLETE. DELAY IS NO LONGER USED ***
' hDmc Handle to the Galil controller.
' Delay Current delay value.
TDMCSetDelay = function ( hDmc : integer;, Delay : integer;) : integer;
' Set delay value.
' *** THIS FUNCTION IS OBSOLETE. DELAY IS NO LONGER USED ***
' hDmc Handle to the Galil controller.
' Delay Delay value.
}
TDMCBinaryCommand = function (hDmc : integer; Command : PChar; CommandLength : integer; Response : PChar; ResponseLength : integer) : integer; stdcall;
{' Send a DMC command in binary format to the Galil controller.
' hDmc Handle to the Galil controller.
' Command The command to send to the Galil controller.
' CommandLength The length of the command (binary commands are not null-terminated).
' Response Buffer to receive the response data. If the buffer is too
' small to recieve all the response data from the controller,
' the error code DMCERROR_BUFFERFULL will be returned. The
' user may get additional response data by calling the
' function DMCGetAdditionalResponse. The length of the
' additonal response data may ascertained by call the
' function DMCGetAdditionalResponseLen. If the response
' data from the controller is too large for the internal
' additional response buffer, the error code
' DMCERROR_RESPONSEDATA will be returned. Output only.
' ResponseLength Length of the buffer.
}
{ TDMCSendBinaryFile = function ( hDmc : integer;, FileName : PChar;) : integer;
' Send a file consisting of DMC commands in binary format to the Galil controller.
' hDmc Handle to the Galil controller.
' FileName File name to send to the Galil controller.
TDMCCommand_BinaryToAscii = function ( hDmc : integer;, BinCommand : PChar;, BinCommandLength : integer;, AscResult : PChar;, AscResultLength : integer;, AscResultReturnedLength : integer;) : integer;
' Convert a binary DMC command to an ascii DMC command.
' hDmc Handle to the Galil controller.
' BinCommand Binary DMC command(s) to be converted.
' BinCommandLength Length of DMC command(s).
' AscResult Buffer to receive the translated DMC command.
' AscResultLength Length of the buffer.
' AscResultReturnedLength Length of the translated DMC command.
TDMCCommand_AsciiToBinary = function ( hDmc : integer;, AscCommand : PChar;, AscCommandLength : integer;, BinResult : PChar;, BinaryResult : integer;, BinResultReturnedLength : integer;) : integer;
' Convert an ascii DMC command to a binary DMC command.
' hDmc Handle to the Galil controller.
' AscCommand Ascii DMC command(s) to be converted.
' AscCommandLength Length of DMC command(s).
' BinResult Buffer to receive the translated DMC command.
' BinResultLength Length of the buffer.
' BinResultReturnedLength Length of the translated DMC command.
TDMCFile_AsciiToBinary = function ( hDmc : integer;, InputFileName : PChar;, OutputFileName : PChar;) : integer;
' Convert a file consisting of ascii commands to a file consisting of binary commands.
' hDmc Handle to the Galil controller.
' InputFileName File name for the input ascii file.
' OutputFileName File name for the output binary file.
TDMCFile_BinaryToAscii = function ( hDmc : integer;, InputFileName : PChar;, OutputFileName : PChar;) : integer;
' Convert a file consisting of binary commands to a file consisting of ascii commands.
' hDmc Handle to the Galil controller.
' InputFileName File name for the input binary file.
' OutputFileName File name for the output ascii file.
TDMCReadSpecialConversionFile = function ( hDmc : integer;, FileName : PChar;) : integer;
' Read into memory a special BinaryToAscii/AsciiToBinary conversion table.
' hDmc Handle to the Galil controller.
' FileName File name for the special conversion file.
TDMCAddGalilRegistry = function (GALILREGISTRY As GALILREGISTRY, Controller : integer; ) : integer;
' Add a Galil controller to the Windows registry.
' galilregistry Pointer to a GALILREGISTRY struct.
' Controller Galil controller number assigned by the successful completion of this function.
TDMCModifyGalilRegistry = function ( Controller : integer; , GALILREGISTRY As GALILREGISTRY) : integer;
' Change a Galil controller in the Windows registry.
' Controller Galil controller number.
' galilregistry Pointer to a GALILREGISTRY struct.
TDMCDeleteGalilRegistry = function ( Controller : integer; ) : integer;
' Delete a Galil controller in the Windows registry.
' Controller Galil controller number. Use -1 to delete all Galil controllers.
TDMCGetGalilRegistryInfo = function ( Controller : integer; , GALILREGISTRY As GALILREGISTRY) : integer;
' Get Windows registry information for a given Galil controller.
' Controller Galil controller number.
' galilregistry Pointer to a GALILREGISTRY struct.
TDMCRegisterPnpControllers = function (Count : integer; ) : integer;
' Update Windows registry for all Galil Plug-and-Play (PnP) controllers. This function
' will add new controllers to the registry or update existing ones.
' Count Pointer to the number of Galil PnP controllers registered (and/or updated).
TDMCSelectController = function ( hWnd : integer;) : integer;
' Select a Galil motion controller from a list of registered controllers. Returns the
' selected controller number or -1 if no controller was selected.
' NOTE: This function invokes a dialog window.
' hwnd The window handle of the calling application. If NULL, the
' window with the current input focus is used.
Public Declare Sub DMCEditRegistry = function ( hWnd : integer; )
' Edit the Windows registry: add, change, or delete Galil motion controllers.
' NOTE: This function invokes a dialog window.
' hwnd The window handle of the calling application. If NULL, the
' window with the current input focus is used.
}
TDMCWaitForMotionComplete = function (hDmc : integer; Axes : PChar; DispatchMsgs : WordBool) : integer; stdcall;
{' Wait for motion complete by creating a thread to query the controller. The function returns
' when motion is complete.
' hDmc Handle to the Galil controller.
' Axes Which axes to wait for: X, Y, Z, W, E, F, G, H, or S for
' coordinated motion. To wait for more than one axis (other than
' coordinated motion), simply concatenate the axis letters in the string.
' DispatchMsgs Set to TRUE if you want to get and dispatch Windows messages
' while waiting for motion complete. This flag is always TRUE for Win16.
}
{ TDMCDownloadFirmwareFile = function ( hDmc : integer;, FileName : PChar;, DisplayDialog : integer; ) : integer;
' Update the controller's firmware. This function will open a binary firmware file and refresh
' the flash EEPROM of the controller.
' hDmc Handle to the Galil controller.
' FileName File name to download to the Galil controller.
' DisplayDialog Display a progress dialog to the user.
TDMCReadRegister = function ( hDmc : integer;, Offset : integer; , Status As Byte) : integer;
' Read from a register (FIFO) of a bus controller.
' NOTE: This function is for Galil bus controllers and Win32 only.
' ** THIS FUNCTION IS FOR EXPERIENCED PROGRAMMERS ONLY **
' hDmc Handle to the Galil controller.
' Offset Register offset. 0 = mailbox, 1 = status.
' Status Buffer to receive status register data.
TDMCWriteRegister = function ( hDmc : integer;, Offset : integer; , Status As Byte) : integer;
' Write to a register (FIFO) of a bus controller.
' NOTE: This function is for Galil bus controllers and Win32 only.
' ** THIS FUNCTION IS FOR EXPERIENCED PROGRAMMERS ONLY **
' hDmc Handle to the Galil controller.
' Offset Register offset. 0 = mailbox, 1 = status.
' Status Status register data.
}
implementation
end.
Raw
file infor
unit fileinfou;
interface
uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
Buttons, ExtCtrls, ComCtrls, Spin, Mainfrm;
type
TConfigdlg = class(TForm)
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
PageControl1: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
TabSheet3: TTabSheet;
TabSheet4: TTabSheet;
TabSheet5: TTabSheet;
CheckBox1: TCheckBox;
Label2: TLabel;
ComboBox2: TComboBox;
Label3: TLabel;
Edit1: TEdit;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
SpinEdit1: TSpinEdit;
SpinEdit2: TSpinEdit;
SpinEdit3: TSpinEdit;
SpinEdit4: TSpinEdit;
Label13: TLabel;
Label14: TLabel;
Label15: TLabel;
Label16: TLabel;
Label17: TLabel;
Label1: TLabel;
Label20: TLabel;
CheckBox2: TCheckBox;
Label21: TLabel;
Edit2: TEdit;
Label22: TLabel;
ComboBox1: TComboBox;
CheckBox3: TCheckBox;
Edit3: TEdit;
Label23: TLabel;
Label24: TLabel;
ComboBox3: TComboBox;
Button1: TButton;
Label10: TLabel;
Label11: TLabel;
Label12: TLabel;
Label25: TLabel;
Label26: TLabel;
ComboBox4: TComboBox;
Edit4: TEdit;
Edit5: TEdit;
Label27: TLabel;
SpinEdit6: TSpinEdit;
Label28: TLabel;
Bevel2: TBevel;
Label29: TLabel;
SpinButton1: TSpinButton;
SpeedButton1: TSpeedButton;
Edit9: TEdit;
Edit10: TEdit;
Label9: TLabel;
CheckBox4: TCheckBox;
Label18: TLabel;
Edit6: TEdit;
Label19: TLabel;
ComboBox5: TComboBox;
Label30: TLabel;
Edit7: TEdit;
Label31: TLabel;
ComboBox6: TComboBox;
Label32: TLabel;
Edit8: TEdit;
Label33: TLabel;
Label34: TLabel;
Edit11: TEdit;
Label35: TLabel;
SpinEdit5: TSpinEdit;
Label36: TLabel;
Bevel1: TBevel;
Label37: TLabel;
Label38: TLabel;
Label39: TLabel;
Label41: TLabel;
Label42: TLabel;
Label43: TLabel;
Label44: TLabel;
Label45: TLabel;
Label40: TLabel;
Label46: TLabel;
Bevel3: TBevel;
SpinButton2: TSpinButton;
Label47: TLabel;
Bevel4: TBevel;
Label48: TLabel;
Bevel5: TBevel;
Label49: TLabel;
Bevel6: TBevel;
Label50: TLabel;
procedure FormShow(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Edit7Change(Sender: TObject);
procedure Edit5Change(Sender: TObject);
procedure CheckBox1Click(Sender: TObject);
procedure CheckBox2Click(Sender: TObject);
procedure CheckBox3Click(Sender: TObject);
procedure CheckBox4Click(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure SpinEdit1Change(Sender: TObject);
procedure SpinEdit2Change(Sender: TObject);
procedure SpinEdit3Change(Sender: TObject);
procedure SpinEdit4Change(Sender: TObject);
procedure Edit9Change(Sender: TObject);
procedure Edit1Change(Sender: TObject);
procedure ComboBox2Change(Sender: TObject);
procedure Edit2Change(Sender: TObject);
procedure ComboBox1Change(Sender: TObject);
procedure Edit3Change(Sender: TObject);
procedure ComboBox3Change(Sender: TObject);
procedure Edit10Change(Sender: TObject);
procedure Edit4Change(Sender: TObject);
procedure SpinEdit6Change(Sender: TObject);
procedure Edit6Change(Sender: TObject);
procedure ComboBox5Change(Sender: TObject);
procedure Edit8Change(Sender: TObject);
procedure Edit11Change(Sender: TObject);
procedure SpinEdit5Change(Sender: TObject);
procedure SpinButton1DownClick(Sender: TObject);
procedure SpinButton1UpClick(Sender: TObject);
procedure SpinButton2DownClick(Sender: TObject);
procedure SpinButton2UpClick(Sender: TObject);
private
{ Private declarations }
{Modification flags}
bModified,
bBlockEdit9Change,
bFrameWidthChanged,
bFrameHeightChanged,
bFrameXOffsetChanged,
bFrameYOffsetChanged,
bFrameRateChanged,
bCh1Changed,
bCh2Changed,
bCh3Changed,
bCh3DataPtsChanged,
bCh4Changed,
bCh4DataPtsChanged: boolean;
newPixelRate: integer;
newFrameRate: double;
procedure EnableCh1;
procedure EnableCh2;
procedure EnableCh3;
procedure EnableCh4;
procedure OnPixelRateChanged;
procedure SetConvFactorUnit1;
procedure SetConvFactorUnit2;
function ValidateFrameWidth(value: integer): boolean;
function ValidateFrameHeight(var value: integer): boolean;
function ValidateXOffset(value: integer): boolean;
function ValidateYOffset(value: integer): boolean;
function ValidateFrameRate(value: double): boolean;
function ValidateVideoChs: boolean;
function ValidateDataPtsCh(value: integer): boolean;
public
{ Public declarations }
bNoFrameDimChange: boolean;
end;
var
Configdlg: TConfigdlg;
implementation
{$R *.DFM}
uses MPUnit, Dialogs, Math;
procedure TConfigdlg.EnableCh1;
begin
Edit1.Enabled := CheckBox1.Checked;
ComboBox2.Enabled := CheckBox1.Checked;
end;
procedure TConfigdlg.EnableCh2;
begin
Edit2.Enabled := CheckBox2.Checked;
ComboBox1.Enabled := CheckBox2.Checked;
end;
procedure TConfigdlg.EnableCh3;
begin
Edit3.Enabled := CheckBox3.Checked;
ComboBox3.Enabled := CheckBox3.Checked;
Edit5.Enabled := CheckBox3.Checked;
ComboBox4.Enabled := CheckBox3.Checked;
Edit10.Enabled := CheckBox3.Checked;
Edit4.Enabled := CheckBox3.Checked;
SpinEdit6.Enabled := CheckBox3.Checked;
Label27.Enabled := CheckBox3.Checked;
Label28.Enabled := CheckBox3.Checked;
Label45.Enabled := CheckBox3.Checked;
end;
procedure TConfigdlg.EnableCh4;
begin
Edit6.Enabled := CheckBox4.Checked;
ComboBox5.Enabled := CheckBox4.Checked;
Edit7.Enabled := CheckBox4.Checked;
ComboBox6.Enabled := CheckBox4.Checked;
Edit8.Enabled := CheckBox4.Checked;
Edit11.Enabled := CheckBox4.Checked;
SpinEdit5.Enabled := CheckBox4.Checked;
Label33.Enabled := CheckBox4.Checked;
Label37.Enabled := CheckBox4.Checked;
Label44.Enabled := CheckBox3.Checked;
end;
procedure TConfigdlg.OnPixelRateChanged;
begin
Label46.Caption := IntToStr(newPixelRate * 50) + ' ns';
Label48.Caption := Format('%4.2f', [1e3/(newPixelRate * 50)]) + ' MHz';
Label28.Caption := Format('%5f', [newFrameRate * SpinEdit6.Value]);
Label37.Caption := Format('%5f', [newFrameRate * SpinEdit5.Value]);
end;
procedure TConfigdlg.SetConvFactorUnit1;
begin
Label27.Caption := ComboBox4.Items[ComboBox4.ItemIndex] + Edit5.Text + '/ V at input';
Label45.Caption := ComboBox4.Items[ComboBox4.ItemIndex] + Edit5.Text;
end;
procedure TConfigdlg.SetConvFactorUnit2;
begin
Label33.Caption := ComboBox6.Items[ComboBox6.ItemIndex] + Edit7.Text + '/ V at input';
Label44.Caption := ComboBox6.Items[ComboBox6.ItemIndex] + Edit7.Text;
end;
function TConfigdlg.ValidateFrameWidth(value: integer): boolean;
begin
Result := (value >= 10) and (value <= 500);
end;
function TConfigdlg.ValidateFrameHeight(var value: integer): boolean;
begin
Result := (value >= 10) and (value <= 500);
if Result and Odd(value) then
begin
MessageDlg('Frame height will be adjusted to be a multiple of 2 lines.',
mtInformation, [mbOK], 0);
value := 2 * (value div 2);
if value < 10 then value := 10;
end;
end;
function TConfigdlg.ValidateXOffset(value: integer): boolean;
begin
Result := (value >= 0) and (value <= 490);
end;
function TConfigdlg.ValidateYOffset(value: integer): boolean;
begin
Result := (value >= 0) and (value <= 490);
end;
function TConfigdlg.ValidateFrameRate(value: double): boolean;
var valFrameRate: double;
valPixelRate: integer;
begin
Mainform.Configuration.GetMaxFrameRate(SpinEdit1.Value, SpinEdit2.Value, valFrameRate, valPixelRate);
Result := (value > 0) and (value <= valFrameRate);
end;
function TConfigdlg.ValidateVideoChs: boolean;
begin
Result := Checkbox1.Checked or Checkbox2.Checked;
end;
function TConfigdlg.ValidateDataPtsCh(value: integer): boolean;
begin
Result := (value >= 0) and (value <= spinEdit1.Value * spinEdit2.Value);
end;
procedure TConfigdlg.FormShow(Sender: TObject);
begin
bModified := False;
with mainform.Configuration do
begin
Label50.Caption := ScanModeToString(ScanMode);
if not bNoFrameDimChange then
begin
SpinEdit1.Value := FrameWidth;
SpinEdit2.Value := FrameHeight;
SpinEdit3.Value := XFrameOffset;
SpinEdit4.Value := YFrameOffset;
newFrameRate := FrameRate;
newPixelRate := PixelClock;
end
else
begin
bModified := True; {main form has modified it}
GetMaxFrameRate(SpinEdit1.Value, SpinEdit2.Value, newFrameRate, newPixelRate);
end;
bBlockEdit9Change := True;
Edit9.Text := Format('%f', [newFrameRate]);
bBlockEdit9Change := False;
OnPixelRateChanged;
CheckBox1.Checked := ChEnabled[0];
Edit1.Text := ChNames[0];
ComboBox2.ItemIndex := Integer(ChInputRanges[0]);
CheckBox2.Checked := ChEnabled[1];
Edit2.Text := ChNames[1];
ComboBox1.ItemIndex := Integer(ChInputRanges[1]);
CheckBox3.Checked := ChEnabled[2];
Edit3.Text := ChNames[2];
ComboBox3.ItemIndex := Integer(ChInputRanges[2]);
Edit5.Text := ChUnits[2];
ComboBox4.ItemIndex := Integer(ChPrefixes[2]);
Edit4.Text := Format('%g', [ChOffsets[2]]);
SpinEdit6.Value := ChDataPtsPerFrames[2];
Label28.Caption := Format('%f', [ChAnalogFreqs[2]]);
SetConvFactorUnit1;
CheckBox4.Checked := ChEnabled[3];
Edit6.Text := ChNames[3];
ComboBox5.ItemIndex := Integer(ChInputRanges[3]);
Edit7.Text := ChUnits[3];
ComboBox6.ItemIndex := Integer(ChPrefixes[3]);
Edit11.Text := Format('%g', [ChOffsets[3]]);
SpinEdit5.Value := ChDataPtsPerFrames[3];
Label37.Caption := Format('%f', [ChAnalogFreqs[2]]);
SetConvFactorUnit2;
EnableCh1;
EnableCh2;
EnableCh3;
EnableCh4;
end;
bFrameWidthChanged := False;
bFrameHeightChanged := False;
bFrameXOffsetChanged := False;
bFrameYOffsetChanged := False;
bFrameRateChanged := False;
bCh1Changed := False;
bCh2Changed := False;
bCh3Changed := False;
bCh3DataPtsChanged := False;
bCh4Changed := False;
bCh4DataPtsChanged := False;
end;
procedure TConfigdlg.FormCreate(Sender: TObject);
begin
FillInputRangeListBox(ComboBox2);
FillInputRangeListBox(ComboBox1);
FillInputRangeListBox(ComboBox3);
FillInputRangeListBox(ComboBox5);
FillUnitListBox(ComboBox4, '');
FillUnitListBox(ComboBox6, '');
end;
procedure TConfigdlg.Edit7Change(Sender: TObject);
begin
SetConvFactorUnit2;
bModified := True;
end;
procedure TConfigdlg.Edit5Change(Sender: TObject);
begin
SetConvFactorUnit1;
bModified := True;
end;
procedure TConfigdlg.CheckBox1Click(Sender: TObject);
begin
EnableCh1;
bModified := True; bCh1Changed := True;
end;
procedure TConfigdlg.CheckBox2Click(Sender: TObject);
begin
EnableCh2;
bModified := True; bCh2Changed := True;
end;
procedure TConfigdlg.CheckBox3Click(Sender: TObject);
begin
EnableCh3;
bModified := True;
bCh3Changed := True;
end;
procedure TConfigdlg.CheckBox4Click(Sender: TObject);
begin
EnableCh4;
bModified := True;
bCh4Changed := True;
end;
procedure TConfigdlg.SpeedButton1Click(Sender: TObject);
begin
Mainform.Configuration.GetMaxFrameRate(SpinEdit1.Value, SpinEdit2.Value, newFrameRate, newPixelRate);
bBlockEdit9Change := True;
Edit9.Text := Format('%f', [newFrameRate]);
bBlockEdit9Change := False;
OnPixelRateChanged;
bModified := True;
end;
procedure TConfigdlg.Button1Click(Sender: TObject);
begin
SpinEdit1.Value := 500;
SpinEdit2.Value := 500;
SpinEdit3.Value := 0;
SpinEdit4.Value := 0;
Edit9.Text := '4';
CheckBox1.Enabled := True;
ComboBox2.ItemIndex := 0;
CheckBox2.Enabled := False;
CheckBox3.Enabled := False;
CheckBox4.Enabled := False;
bModified := True;
end;
resourcestring
sFrameWidthNotOK = 'Frame width must be between 10 and 500.';
sFrameHeightNotOK = 'Frame height must be between 10 and 500.';
sFrameXOffsetNotOK = 'Frame X-offset must be between 0 and 490.';
sFrameYOffsetNotOK = 'Frame Y-offset must be between 0 and 490.';
sFrameRateNotOK = 'Invalid Frame Rate.';
sVideoChCountNotOK = 'At least one video channel must be enabled.';
sDataPtsPerFrameNotOKCh1 = 'Invalid number of data points / frame in Analog Ch 1.';
sDataPtsPerFrameNotOKCh2 = 'Invalid number of data points / frame in Analog Ch 2.';
sFrameTooSmall = 'Selected frame is too small.' + CRLF +
'Frames must have at least 512 pixels.';
procedure TConfigdlg.BitBtn1Click(Sender: TObject);
var bValueOK: boolean;
fh: integer;
begin
bValueOK := True;
if bModified then
try
with mainform.Configuration do
begin
{Test critical parameters}
if bValueOK and bFrameWidthChanged then bValueOK := ValidateFrameWidth(SpinEdit1.Value);
if not bValueOK then
begin
MessageDlg(sFrameWidthNotOK, mtError, [mbOK], 0);
SpinEdit1.Value := FrameWidth;
PageControl1.ActivePage := TabSheet1;
end;
fh := SpinEdit2.Value;
if bValueOK and bFrameHeightChanged then bValueOK := ValidateFrameHeight(fh);
if not bValueOK then
begin
MessageDlg(sFrameHeightNotOK, mtError, [mbOK], 0);
SpinEdit2.Value := FrameHeight;
PageControl1.ActivePage := TabSheet1;
end
else
SpinEdit2.Value := fh;
{for double-buffered DMA using the FIFO buffer, the number of samples
transferred by WFM_Load must be larger than 2048 samples = 2 channels
* 2 frames * total number of pixels}
if bValueOK then
if Muldiv(SpinEdit1.Value, 5, 4) * SpinEdit2.Value < 512 then
begin
MessageDlg(sFrameTooSmall, mtError, [mbOK], 0);
PageControl1.ActivePage := TabSheet1;
bValueOK := False;
end;
if bValueOK and bFrameXOffsetChanged then bValueOK := ValidateXOffset(SpinEdit3.Value);
if not bValueOK then
begin
MessageDlg(sFrameXOffsetNotOK, mtError, [mbOK], 0);
SpinEdit3.Value := XFrameOffset;
PageControl1.ActivePage := TabSheet1;
end;
if bValueOK and bFrameYOffsetChanged then bValueOK := ValidateYOffset(SpinEdit4.Value);
if not bValueOK then
begin
MessageDlg(sFrameYOffsetNotOK, mtError, [mbOK], 0);
SpinEdit4.Value := YFrameOffset;
PageControl1.ActivePage := TabSheet1;
end;
if bValueOK and bFrameRateChanged then bValueOK := ValidateFrameRate(StrToFloat(Edit9.Text));
if not bValueOK then
begin
MessageDlg(sFrameRateNotOK, mtError, [mbOK], 0);
Edit9.Text := Format('%f', [FrameRate]);
PageControl1.ActivePage := TabSheet1;
end;
if bValueOK and (bCh1Changed or bCh2Changed) then bValueOK := ValidateVideoChs;
if not bValueOK then
begin
MessageDlg(sVideoChCountNotOK, mtError, [mbOK], 0);
CheckBox1.Checked := True;
PageControl1.ActivePage := TabSheet2;
end;
if bValueOK and bCh3DataPtsChanged then bValueOK := ValidateDataPtsCh(SpinEdit6.Value);
if not bValueOK then
begin
MessageDlg(sDataPtsPerFrameNotOKCh1, mtError, [mbOK], 0);
SpinEdit6.Value := ChDataPtsPerFrames[2];
PageControl1.ActivePage := TabSheet4;
end;
if bValueOK and bCh4DataPtsChanged then bValueOK := ValidateDataPtsCh(SpinEdit5.Value);
if not bValueOK then
begin
MessageDlg(sDataPtsPerFrameNotOKCh2, mtError, [mbOK], 0);
SpinEdit5.Value := ChDataPtsPerFrames[3];
PageControl1.ActivePage := TabSheet5;
end;
if bValueOK then
begin
{Saves current configuration}
CopyTo(Mainform.prevConfig);
{stuff results back}
FrameWidth := SpinEdit1.Value;
FrameHeight := (SpinEdit2.Value div 2) * 2; {even number of lines}
XFrameOffset := SpinEdit3.Value;
YFrameOffset := SpinEdit4.Value;
PixelClock := newPixelRate;
ChEnabled[0] := CheckBox1.Checked;
ChNames[0] := Edit1.Text;
ChInputRanges[0] := TFullScaleVal(ComboBox2.ItemIndex);
ChEnabled[1] := CheckBox2.Checked;
ChNames[1] := Edit2.Text;
ChInputRanges[1] := TFullScaleVal(ComboBox1.ItemIndex);
ChEnabled[2] := CheckBox3.Checked;
ChNames[2] := Edit3.Text;
ChInputRanges[2] := TFullScaleVal(ComboBox3.ItemIndex);
ChUnits[2] := Edit5.Text;
ChPrefixes[2] := TPrefix(ComboBox4.ItemIndex);
ChOffsets[2] := StrToFloat(Edit4.Text);
ChDataPtsPerFrames[2] := SpinEdit6.Value;
ChEnabled[3] := CheckBox4.Checked;
ChNames[3] := Edit6.Text;
ChInputRanges[3] := TFullScaleVal(ComboBox5.ItemIndex);
ChUnits[3] := Edit7.Text;
ChPrefixes[3] := TPrefix(ComboBox6.ItemIndex);
ChOffsets[3] := StrToFloat(Edit11.Text);
ChDataPtsPerFrames[3] := SpinEdit5.Value;
ModalResult := mrOK;
end
else
ModalResult := mrNone;
end;
except
ModalResult := mrNone;
if bValueOK then Raise; {show the original error message}
end;
end;
procedure TConfigdlg.SpinEdit1Change(Sender: TObject);
begin
bModified := True; bFrameWidthChanged := True;
end;
procedure TConfigdlg.SpinEdit2Change(Sender: TObject);
begin
bModified := True; bFrameHeightChanged := True;
end;
procedure TConfigdlg.SpinEdit3Change(Sender: TObject);
begin
bModified := True; bFrameXOffsetChanged := True;
end;
procedure TConfigdlg.SpinEdit4Change(Sender: TObject);
begin
bModified := True; bFrameYOffsetChanged := True;
end;
procedure TConfigdlg.Edit9Change(Sender: TObject);
begin
if bBlockEdit9Change then Exit;
bModified := True; bFrameRateChanged := True;
if Mainform.Configuration.FrameRateToPixelRate
(StrToFloat(Edit9.Text), SpinEdit1.Value, SpinEdit2.Value, newPixelRate) then
begin
Mainform.Configuration.
PixelRateToFrameRate(newPixelRate, SpinEdit1.Value, SpinEdit2.Value, newFrameRate);
bBlockEdit9Change := True;
Edit9.Text := Format('%f', [newFrameRate]);
bBlockEdit9Change := False;
OnPixelRateChanged;
end;
end;
procedure TConfigdlg.Edit1Change(Sender: TObject);
begin
bModified := True;
end;
procedure TConfigdlg.ComboBox2Change(Sender: TObject);
begin
bModified := True;
end;
procedure TConfigdlg.Edit2Change(Sender: TObject);
begin
bModified := True;
end;
procedure TConfigdlg.ComboBox1Change(Sender: TObject);
begin
bModified := True;
end;
procedure TConfigdlg.Edit3Change(Sender: TObject);
begin
bModified := True;
end;
procedure TConfigdlg.ComboBox3Change(Sender: TObject);
begin
bModified := True;
end;
procedure TConfigdlg.Edit10Change(Sender: TObject);
begin
bModified := True;
end;
procedure TConfigdlg.Edit4Change(Sender: TObject);
begin
bModified := True;
end;
procedure TConfigdlg.SpinEdit6Change(Sender: TObject);
begin
bModified := True; bCh3DataPtsChanged := True;
Label28.Caption := Format('%5f', [newFrameRate * SpinEdit6.Value]);
end;
procedure TConfigdlg.Edit6Change(Sender: TObject);
begin
bModified := True;
end;
procedure TConfigdlg.ComboBox5Change(Sender: TObject);
begin
bModified := True;
end;
procedure TConfigdlg.Edit8Change(Sender: TObject);
begin
bModified := True;
end;
procedure TConfigdlg.Edit11Change(Sender: TObject);
begin
bModified := True;
end;
procedure TConfigdlg.SpinEdit5Change(Sender: TObject);
begin
bModified := True; bCh4DataPtsChanged := True;
Label37.Caption := Format('%5f', [newFrameRate * SpinEdit5.Value]);
end;
procedure TConfigdlg.SpinButton1DownClick(Sender: TObject);
var freq: double;
bChangingPixelRate: boolean;
changedPixelRate: integer;
begin
try
freq := StrToFloat(Edit9.Text);
if freq < 1 then Exit;
bChangingPixelRate := False;
repeat
freq := freq - 1;
if freq >= 0.5 then
begin
Mainform.Configuration.FrameRateToPixelRate
(freq, SpinEdit1.Value, SpinEdit2.Value, changedPixelRate);
if (changedPixelRate <> newPixelRate) then bChangingPixelRate := True;
end;
until bChangingPixelRate or (freq < 0.5);
if bChangingPixelRate then
begin
newPixelRate := changedPixelRate;
OnPixelRateChanged;
Mainform.Configuration.PixelRateToFrameRate
(newPixelRate, SpinEdit1.Value, SpinEdit2.Value, newFrameRate);
bBlockEdit9Change := True;
Edit9.Text := Format('%f', [newFrameRate]);
bBlockEdit9Change := False;
end;
except
mainform.Configuration.GetMaxFrameRate(SpinEdit1.Value, SpinEdit2.Value, newFrameRate, newPixelRate);
bBlockEdit9Change := True;
Edit9.Text := Format('%f', [newFrameRate]);
OnPixelRateChanged;
bBlockEdit9Change := False;
end;
bModified := True; bFrameRateChanged := True;
end;
procedure TConfigdlg.SpinButton1UpClick(Sender: TObject);
var freq: double;
bChangingPixelRate: boolean;
changedPixelRate: integer;
begin
try
freq := StrToFloat(Edit9.Text);
if freq > 1000 then Exit;
bChangingPixelRate := False;
repeat
freq := freq + 1;
if freq < 1000 then
begin
Mainform.Configuration.FrameRateToPixelRate
(freq, SpinEdit1.Value, SpinEdit2.Value, changedPixelRate);
if (changedPixelRate <> newPixelRate) then bChangingPixelRate := True;
end;
until bChangingPixelRate or (freq >= 1000);
if bChangingPixelRate then
begin
newPixelRate := changedPixelRate;
OnPixelRateChanged;
Mainform.Configuration.PixelRateToFrameRate
(newPixelRate, SpinEdit1.Value, SpinEdit2.Value, newFrameRate);
bBlockEdit9Change := True;
Edit9.Text := Format('%f', [newFrameRate]);
bBlockEdit9Change := False;
end;
except
mainform.Configuration.GetMaxFrameRate(SpinEdit1.Value, SpinEdit2.Value, newFrameRate, newPixelRate);
bBlockEdit9Change := True;
Edit9.Text := Format('%f', [newFrameRate]);
bBlockEdit9Change := False;
OnPixelRateChanged;
end;
bModified := True; bFrameRateChanged := True;
end;
procedure TConfigdlg.SpinButton2DownClick(Sender: TObject);
begin
if newPixelRate > 8 then newPixelRate := newPixelRate - 1;
if not Mainform.Configuration.PixelRateToFrameRate
(newPixelRate, SpinEdit1.Value, SpinEdit2.Value, newFrameRate) then
MessageDlg('Pixel Rate too fast for X- mirror to follow.', mtInformation, [mbOK], 0);
bModified := True; bFrameRateChanged := True;
bBlockEdit9Change := True;
Edit9.Text := Format('%f', [newFrameRate]);
bBlockEdit9Change := False;
OnPixelRateChanged;
end;
procedure TConfigdlg.SpinButton2UpClick(Sender: TObject);
begin
if newPixelRate < 999 then newPixelRate := newPixelRate + 1;
if not Mainform.Configuration.PixelRateToFrameRate
(newPixelRate, SpinEdit1.Value, SpinEdit2.Value, newFrameRate) then
MessageDlg('Pixel Rate too fast for X- mirror to follow.', mtInformation, [mbOK], 0);
bBlockEdit9Change := True;
Edit9.Text := Format('%f', [newFrameRate]);
bBlockEdit9Change := False;
bModified := True; bFrameRateChanged := True;
OnPixelRateChanged;
end;
end.
Raw
Frame Option
unit FrameOpDlgu;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons, ExtCtrls, Spin;
type
TFrameOpDlg = class(TForm)
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
GroupBox1: TGroupBox;
RadioButton1: TRadioButton;
RadioButton2: TRadioButton;
SpinEdit1: TSpinEdit;
SpinEdit2: TSpinEdit;
Label1: TLabel;
Label2: TLabel;
GroupBox2: TGroupBox;
Label3: TLabel;
ComboBox1: TComboBox;
private
{ Private declarations }
public
{ Public declarations }
end;
var
FrameOpDlg: TFrameOpDlg;
implementation
{$R *.DFM}
end.
Raw
Gali Test Frame
unit galiltestfrm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, DMCCom40u,
StdCtrls, Buttons;
type
TForm1 = class(TForm)
Label1: TLabel;
BitBtn1: TBitBtn;
Edit1: TEdit;
Label2: TLabel;
Label3: TLabel;
BitBtn2: TBitBtn;
Label4: TLabel;
BitBtn3: TBitBtn;
Edit2: TEdit;
Label5: TLabel;
BitBtn4: TBitBtn;
BitBtn5: TBitBtn;
BitBtn6: TBitBtn;
Edit3: TEdit;
Edit4: TEdit;
Edit5: TEdit;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
BitBtn7: TBitBtn;
BitBtn8: TBitBtn;
Label9: TLabel;
Label10: TLabel;
Label11: TLabel;
Label12: TLabel;
Label13: TLabel;
Label14: TLabel;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure BitBtn3Click(Sender: TObject);
procedure BitBtn4Click(Sender: TObject);
procedure BitBtn5Click(Sender: TObject);
procedure BitBtn6Click(Sender: TObject);
procedure BitBtn7Click(Sender: TObject);
procedure BitBtn8Click(Sender: TObject);
private
{ Private declarations }
inputstring, outputstring: String;
initialCounts, initialPositions: array[0..2] of integer;
public
{ Public declarations }
libHandle: THandle;
controllerHandle: integer;
DMCOpen: TDMCOpen;
DMCClose: TDMCClose;
DMCCommand: TDMCCommand;
DMCWaitForMotionComplete: TDMCWaitForMotionComplete;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
var retval: integer;
freq: TLargeInteger;
s2, s3: string;
begin
libHandle := LoadLibrary('dmc32.dll');
if libHandle <> 0 then
begin
DMCOpen := GetProcAddress(libHandle, 'DMCOpen');
DMCClose := GetProcAddress(libHandle, 'DMCClose');
DMCCommand := GetProcAddress(libHandle, 'DMCCommand');
DMCWaitForMotionComplete := GetProcAddress(libHandle, 'DMCWaitForMotionComplete');
if Assigned(DMCOpen) then
begin
retval := DMCOpen(1, 0, controllerHandle);
if retval = 0 then
begin
Label1.Caption := 'Controller OK';
SetLength(outputstring, 128);
inputstring := 'HX 0;MT -2,-2,-2;CE 0,0,0,0;YA 16,16,16;YB 400,400,400;SP 3000,3000,3000;LD 0,0,0;CN -1,-1,-1,0,0;OB 1,1;OB 2,1;OB 3,1';
Label2.Caption := IntToStr(DMCCommand(controllerHandle, PChar(inputstring), PChar(outputString), 64));
Label3.Caption := outputString;
{finds initial counts and position}
inputstring := 'PA ?,?,?';
IntToStr(DMCCommand(controllerHandle, PChar(inputstring), PChar(outputString), 64));
initialCounts[0] := StrToInt(Copy(outputString, 2, Pos(',', outputString) - 2));
s2 := Copy(outputString, Pos(',', outputString) + 1, Pos(':', outputString) - Pos(',', outputString));
initialCounts[1] := StrToInt(Copy(s2, 2, Pos(',', s2) - 2));
s3 := Copy(s2, Pos(',', s2) + 1, Pos(Chr(13), s2) - Pos(',', s2));
initialCounts[2] := StrToInt(Copy(s3, 2, Pos(Chr(13), s3) - 2));
inputstring := 'TPABC';
IntToStr(DMCCommand(controllerHandle, PChar(inputstring), PChar(outputString), 64));
initialPositions[0] := StrToInt(Copy(outputString, 2, Pos(',', outputString) - 2));
s2 := Copy(outputString, Pos(',', outputString) + 1, Pos(':', outputString) - Pos(',', outputString));
initialPositions[1] := StrToInt(Copy(s2, 2, Pos(',', s2) - 2));
s3 := Copy(s2, Pos(',', s2) + 1, Pos(Chr(13), s2) - Pos(',', s2));
initialPositions[2] := StrToInt(Copy(s3, 2, Pos(Chr(13), s3) - 2));
Label9.Caption := IntToStr(initialCounts[0]);
Label10.Caption := IntToStr(initialCounts[1]);
Label11.Caption := IntToStr(initialCounts[2]);
Label12.Caption := IntToStr(initialPositions[0]);
Label13.Caption := IntToStr(initialPositions[1]);
Label14.Caption := IntToStr(initialPositions[2]);
end
else
Label1.Caption := 'Controller Failed: ' + IntToStr(retval);
end;
{opens galil}
end;
QueryPerformanceFrequency(freq);
Label5.Caption := IntToStr(freq);
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if Assigned(DMCClose) then
begin
inputstring := 'XQ 0';
SetLength(outputstring, 1024);
Label2.Caption := IntToStr(DMCCommand(controllerHandle, PChar(inputstring), PChar(outputString), 64));
DMCClose(controllerHandle);
end;
FreeLibrary(libHandle);
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
SetLength(outputstring, 64);
inputstring := 'PR ,,' + Edit1.Text + ';BGZ';
Label2.Caption := IntToStr(DMCCommand(controllerHandle, PChar(inputstring), PChar(outputString), 64));
Label3.Caption := outputString;
inputString := 'XYZ';
Label2.Caption := IntToStr(DMCWaitForMotionComplete(controllerHandle, PChar(inputstring), 1));
BitBtn2Click(nil);
end;
procedure TForm1.BitBtn2Click(Sender: TObject);
begin
inputstring := 'TP';
SetLength(outputstring, 1024);
Label2.Caption := IntToStr(DMCCommand(controllerHandle, PChar(inputstring), PChar(outputString), 1024));
Label4.Caption := outputString;
Edit2.Text := outputString;
end;
procedure TForm1.BitBtn3Click(Sender: TObject);
begin
inputstring := 'ST;';
SetLength(outputstring, 1024);
Label2.Caption := IntToStr(DMCCommand(controllerHandle, PChar(inputstring), PChar(outputString), 1024));
Label4.Caption := outputString;
end;
procedure TForm1.BitBtn4Click(Sender: TObject);
begin
SetLength(outputstring, 64);
inputstring := 'PAA=' +
IntToStr(initialCounts[0] - Muldiv(16, 10 * StrToInt(Edit3.Text) - InitialPositions[0], 50))
+ ';BGA';
Label2.Caption := IntToStr(DMCCommand(controllerHandle, PChar(inputstring), PChar(outputString), 64));
Label3.Caption := outputString;
inputString := 'X';
Label2.Caption := IntToStr(DMCWaitForMotionComplete(controllerHandle, PChar(inputstring), 1));
end;
procedure TForm1.BitBtn5Click(Sender: TObject);
begin
SetLength(outputstring, 64);
inputstring := 'PAB=' +
IntToStr(initialCounts[1] - Muldiv(16, 10 * StrToInt(Edit4.Text) - InitialPositions[1], 50))
+ ';BGB';
Label2.Caption := IntToStr(DMCCommand(controllerHandle, PChar(inputstring), PChar(outputString), 64));
Label3.Caption := outputString;
inputString := 'Y';
Label2.Caption := IntToStr(DMCWaitForMotionComplete(controllerHandle, PChar(inputstring), 1));
end;
procedure TForm1.BitBtn6Click(Sender: TObject);
begin
SetLength(outputstring, 64);
inputstring := 'PAC=' +
IntToStr(initialCounts[2] - Muldiv(16, 10 * StrToInt(Edit5.Text) - InitialPositions[2], 50))
+ ';BGC';
Label2.Caption := IntToStr(DMCCommand(controllerHandle, PChar(inputstring), PChar(outputString), 64));
Label3.Caption := outputString;
inputString := 'Z';
Label2.Caption := IntToStr(DMCWaitForMotionComplete(controllerHandle, PChar(inputstring), 1));
end;
procedure TForm1.BitBtn7Click(Sender: TObject);
begin
SetLength(outputstring, 64);
inputstring := 'PA ?,?,?';
Label2.Caption := IntToStr(DMCCommand(controllerHandle, PChar(inputstring), PChar(outputString), 64));
Edit1.Text := outputString;
end;
procedure TForm1.BitBtn8Click(Sender: TObject);
begin
SetLength(outputstring, 64);
inputstring := 'PAA=' +
Edit3.Text
+ ';BGA';
Label2.Caption := IntToStr(DMCCommand(controllerHandle, PChar(inputstring), PChar(outputString), 64));
Label3.Caption := outputString;
end;
end.
Raw
Gali Tread Unit
unit GalilThreadU;
{Manages the Galil DMC-40 controller}
{$ASSERTIONS ON}
interface
uses
Classes, Windows, DMCCom40u, StrUtils, Dialogs;
type
TGALIL_Action =
(GALIL_NO_ACTION,
GALIL_SET_XY_SPEED,
GALIL_SET_Z_SPEED,
GALIL_GET_Z,
GALIL_SET_Z,
GALIL_SET_TO_RELATIVE_Z,
GALIL_SET_TO_RELATIVE_Z_NO_UPDATE, {for stacks}
GALIL_MOVE_TO_Z,
GALIL_READ_Z,
{GALIL_SHIFT_BY_Z, (not used)}
GALIL_GET_XY,
GALIL_SET_XY,
GALIL_SET_TO_RELATIVE_XY,
GALIL_MOVE_TO_XY,
GALIL_READ_XY,
GALIL_SHIFT_BY_XY,
GALIL_FAST_STACK,
GALIL_COMMAND);
TGalilThread = class(TThread)
private
// Galil function variables
fbConnected: boolean;
libHandle: THandle;
DMCOpen: TDMCOpen;
DMCClose: TDMCClose;
inputstring, outputstring: string;
initialCounts, initialPositions: array[0..2] of integer;
stepsToMoveZafterFastStack: integer;
posBeforeFastStackCountsZ: string;
speedBeforeFastStackZ: string;
procedure UpdateUserInterfaceZ;
procedure UpdateUserInterfaceXY;
procedure UnloadGALILLibrary;
public
controllerHandle: integer; // 8-6-09 ALS - made public
DMCCommand: TDMCCommand; // 8-6-09 ALS - made public
DMCWaitForMotionComplete: TDMCWaitForMotionComplete; // 8-6-09 - made public
DMCSetTimeout: TDMCSetTimeout; // 8-6-09 ALS - new function
GalilAction : TGALIL_Action;
GalilParam1, GalilParam2: double;
zSpeedBeforeFastStack: double; // keep track of this, for resetting after fast stack
//jdz - used to pass values into the fast stack, which is actually
// executed as a thread
fastStackInterval: double; // in microns - not used
fastStackSpeed: double; // in microns per second, will be 1-60
fastStackDistance: double; // distance for fast stack, in microns
GalilCommandString: string;
procedure GetXY(var x, y: integer); //jd - moved to public
procedure GetZ(var z: double); //jd - moved to public
procedure ConnectToGALIL;
procedure Execute; override;
procedure WaitForMotionComplete; //PB
procedure ResetSpeedAndPosAfterFastStackZ; //jdz used to return the stage to the previous speed after fast stack
constructor Create(CreateSuspended: boolean);
destructor Destroy; override;
property Connected: boolean read fbConnected;
function InMotionZ: boolean; // true if the stage is moving in Z
procedure StopMotion; //jd - halt motion
end;
implementation
uses Sysutils, Math, MPUnit, mpdevices;
const
ENCODER_RESOLUTION_Z = 0.1; {0.1 micron}
ENCODER_RESOLUTION_XY = 1.0; // RIG - 1.0 for both Laser RM1 rigs, 0.1 for Laser RM2
EPSILON_XY = 16 div 5; {close-loop will tolerate error EPSILON_XY of ~ 1 micron}
// original line from March 2009 ... removing most setup parameters,
// which are set when the joystick code executies,
// so this code is more universal
//sGalilStart = 'HX 0;MT=-2,-2,-2;CE 0,0,0;YA 16,16,16;YB 400,400,400;LD 0,0,0;OB 1,1;OB 2,1;OB 3,1;AC=10000,10000,10000;DC=10000,10000,10000;';
// sGalilStart = 'HX 0;CE 0,0,0;OB 1,1;OB 2,1;OB 3,1;';
// sGalilStart = 'HX 0;OB 1,1;OB 2,1;OB 3,1;'; // 7-29-09 ALS
sGalilStart = 'HX;XQ #limtest,0;OB 1,1;OB 2,1;OB 3,1;LD 0,0,0'; //PB 7-31-09
sGalilEnd = 'OB 1,0;OB 2,0;OB 3,0;HX;ST;MO;XQ #AUTO';
sSetupMoveCommandRZ = 'SPC=%s;ACC=%s;DCC=%s;PRC=%s;BGZ';
sSetupMoveCommandAZ = 'SPC=%s;ACC=%s;DCC=%s;PAC=%s;BGZ';
sMoveCompleteZ = 'C';
sResumeZ = 'OB 3,0;XQ 0';
sSetupMoveCommandRXY = 'SP %s,%s;AC %s,%s;DC %s,%s;PR %s,%s;BG AB;';
sSetupMoveCommandAXY = 'SP %s,%s;AC %s,%s;DC %s,%s;PA %s,%s;BG AB;';
sMoveCompleteXY = 'AB';
sResumeXY = 'OB 1,0;OB 2,0;XQ 0';
// move relative lines are not currently used
//sMoveRelativeXY = 'OB 1,1;OB 2,1;PR %s,%s;BGXY;';
//sMoveRelativeZ = 'OB 3,1;PR ,,%s;BGZ;';
sSetZSpeed = 'SPC=%s';
sResumeExecution: PChar = 'XQ 0';
sFastStackMoveRZ = 'PRZ=%s;BGZ'; //PB
MIN_XY_SPEED = 200; {arbitrary limit on speed (in MICROSTEPS! counts/s)}
MAX_XY_SPEED = 20000; //PB
MIN_Z_SPEED = 200;
MAX_Z_SPEED = 20000; //PB
MIN_XY_ACC = 1000; {acceleration and deceleration have to match speed and load???}
MIN_XY_DEC = 1000;
MIN_Z_ACC = 1000;
MIN_Z_DEC = 1000;
GALIL_READ_DELAY = 100; {in ms}
procedure TGalilThread.ResetSpeedAndPosAfterFastStackZ;
begin
// function is used to Reset the Speed, and also return the Z to the
// original position (before a fast stack)
// !!! do not call this function without calling FAST_STACK first,
// since the output strings will be set to junk!
WaitForMotionComplete;
//inputString := 'SPZ= 5000';
//DMCCommand(controllerHandle, PChar(inputstring), PChar(outputString), 128);
// reset the speed
inputString := 'SPZ= ' + speedBeforeFastStackZ + ';';
DMCCommand(controllerHandle, PChar(inputstring), PChar(outputString), 128);
// also reset postion
inputString := 'PAZ= ' + posBeforeFastStackCountsZ + ';BGZ;';
DMCCommand(controllerHandle, PChar(inputstring), PChar(outputString), 128);
end;
procedure TGalilThread.StopMotion;
begin
inputString := 'ST XYZ';
DMCCommand(controllerHandle, PChar(inputstring), PChar(outputString), 128);
end;
//jdz
function TGalilThread.InMotionZ: boolean;
var
c: AnsiChar;
str: string;
begin
SetLength(outputstring, 128);
inputstring := 'MG _BGZ';
DMCCommand(controllerHandle, PChar(inputstring), PChar(outputString), 128);
//messageBox(0,pchar(outputString),'',0);
// 'MG _BGZ' returns 1 is in motion, 0 otherwise
Result := false;
str := Copy(outputString,2,1); // character will be 1 or 0, depending on motion
if str = '1' then Result := true;
//if Result then messageBox(0,'moving','',0)
//else messageBox(0,'stopped','not moving',0);
//messageBox(0,'test',outputString,0);
end;
procedure TGalilThread.GetZ(var z: double);
begin
// wait for motion to complete and add a delay,
// this keep the updated position correct,
// but keeps you from rapidly pressing the move button
// - don't use delay
//DMCWaitForMotionComplete(controllerHandle, 'Z', FALSE);
//Delay(GALIL_READ_DELAY); // small delay to make sure motion has settled
SetLength(outputstring, 128);
inputstring := 'TP C';
if DMCCommand(controllerHandle, PChar(inputstring), PChar(outputString), 128) = 0 then
try
{convert to microns; encoders are 0.1 um - Galil returns string ' 1234:CR'}
z := ENCODER_RESOLUTION_Z * StrToFloat(Copy(outputString, 2, Pos(':', outputString) - 4));
except
z := 0;
end;
end;
procedure TGalilThread.GetXY(var x, y: integer);
begin
// wait for motion to complete and add a delay,
// this keep the updated position correct,
// but keeps you from rapidly pressing the move button
DMCWaitForMotionComplete(controllerHandle, 'XY', FALSE);
Delay(GALIL_READ_DELAY); // small delay to make sure motion has settled
SetLength(outputstring, 128);
inputstring := 'TP AB';
if DMCCommand(controllerHandle, PChar(inputstring), PChar(outputstring), 128) = 0 then
try
{convert to microns}
x := Round(ENCODER_RESOLUTION_XY * StrToFloat(Copy(outputString, 2, Pos(',', outputString) - 2)));
y := Round(ENCODER_RESOLUTION_XY * StrToFloat(Copy(outputString, Pos(',', outputString) + 2, Pos(':', outputString) - Pos(',', outputString) - 4)));
except
x := 0; y := 0;
end;
//MessageBox(0,pchar(floatToStr(x)),pchar(floatToStr(y)),0);
end;
procedure TGalilThread.WaitForMotionComplete;
begin
DMCWaitForMotionComplete(controllerHandle, 'XYZ', FALSE);
end;
procedure TGalilThread.ConnectToGALIL;
var s2, s3: string;
begin
libHandle := LoadLibrary('dmc32.dll');
if libHandle <> 0 then
begin
DMCOpen := GetProcAddress(libHandle, 'DMCOpen'); // get function pointer from DLL
DMCClose := GetProcAddress(libHandle, 'DMCClose');
DMCCommand := GetProcAddress(libHandle, 'DMCCommand');
DMCWaitForMotionComplete := GetProcAddress(libHandle, 'DMCWaitForMotionComplete');
DMCSetTimeout := GetProcAddress(libHandle, 'DMCSetTimeout'); // 8-6-09 ALS
if Assigned(DMCOpen) then
fbConnected := (DMCOpen(1, 0, controllerHandle) = 0); // controller #1 default
if fbConnected then
begin
{sets up Galil default parameters}
inputString := sGalilStart;
SetLength(outputstring, 128);
DMCCommand(controllerHandle, PChar(inputstring), PChar(outputString), 128);
{finds initial stepper counts and position}
inputstring := 'PA ?,?,?';
IntToStr(DMCCommand(controllerHandle, PChar(inputstring), PChar(outputString), 64));
initialCounts[0] := StrToInt(Copy(outputString, 2, Pos(',', outputString) - 2));
s2 := Copy(outputString, Pos(',', outputString) + 1, Pos(':', outputString) - Pos(',', outputString));
initialCounts[1] := StrToInt(Copy(s2, 2, Pos(',', s2) - 2));
s3 := Copy(s2, Pos(',', s2) + 1, Pos(Chr(13), s2) - Pos(',', s2));
initialCounts[2] := StrToInt(Copy(s3, 2, Pos(Chr(13), s3) - 2));
inputstring := 'TPABC';
IntToStr(DMCCommand(controllerHandle, PChar(inputstring), PChar(outputString), 64));
initialPositions[0] := StrToInt(Copy(outputString, 2, Pos(',', outputString) - 2));
s2 := Copy(outputString, Pos(',', outputString) + 1, Pos(':', outputString) - Pos(',', outputString));
initialPositions[1] := StrToInt(Copy(s2, 2, Pos(',', s2) - 2));
s3 := Copy(s2, Pos(',', s2) + 1, Pos(Chr(13), s2) - Pos(',', s2));
initialPositions[2] := StrToInt(Copy(s3, 2, Pos(Chr(13), s3) - 2));
end;
end;
end;
procedure TGalilThread.UnloadGalilLibrary;
begin
if libHandle = 0 then Exit;
if Assigned(DMCClose) then
begin
inputString := sGalilEnd;
SetLength(outputstring, 128);
DMCCommand(controllerHandle, PChar(inputstring), PChar(outputString), 128);
//Delay(100); // wait to make sure characters have been sent
DMCClose(controllerHandle);
end;
FreeLibrary(libHandle);
end;
{ Important: Methods and properties of objects in VCL can only be used in a
method called using Synchronize, for example,
Synchronize(UpdateCaption);
and UpdateCaption could look like,
procedure TXPSThread.UpdateCaption;
begin
Form1.Caption := 'Updated in a thread';
end; }
procedure TGalilThread.UpdateUserInterfaceZ;
begin
ZStepper.OnMoveFinished;
end;
procedure TGalilThread.UpdateUserInterfaceXY;
begin
XYTable.OnMoveFinished;
end;
{ TGalilThread }
procedure TGalilThread.Execute;
var stepsToMoveX, stepsToMoveY, stepsToMoveZ: integer;
begin
{ Place thread code here }
SetLength(outputstring, 128);
while not Terminated do
{Loops continuously}
{wait for 1000 ms each time}
if WaitForSingleObject(dmc40.GalilSemaphore, 1000) = WAIT_OBJECT_0 then
begin
// xyTable.Busy := True;
// zStepper.Busy := True;
try
case GalilAction of
GALIL_SET_Z_SPEED:
begin
zSpeedBeforeFastStack := GalilParam1; // keep this, to reset the speed
inputString := Format(sSetZSpeed, [Round(GalilParam1)]);
DMCCommand(controllerHandle, PChar(inputstring), PChar(outputString), 128);
end;
GALIL_GET_Z, GALIL_READ_Z:
begin
GetZ(ZStepper.fzPosition);
Synchronize(UpdateUserInterfaceZ);
end;
GALIL_SET_Z, GALIL_MOVE_TO_Z:
begin
//jdz
// the only time this function is called is
// to return the stages to the original position (after FastStack)
// so, change function here to handle this case, to get
// fast stack working ...
// essentially, do nothing here (except update position)
// actual handling of resetting speed and pos is in
// ResetSpeedAndPosAfterFastStackZ
//messageBox(0,'called GALIL_SET_Z','distance',0);
//jdz
//WaitForMotionComplete(); //jdz - shouldn't need to do this, should already be complete
//inputString := Format(sFastStackMoveRZ, [IntToStr(stepsToMoveZafterFaststack)]);
//DMCCommand(controllerHandle, PChar(inputstring), PChar(outputString), 128);
{convert from microns to steps = 16/5 * (10 * positioninmicrons - initialposition) / 10}
//stepsToMoveZ := initialCounts[2] - Muldiv(16, Round(10 * GalilParam1) - InitialPositions[2], 50); //jd - should be tied to GALIL_ENCODER_
{------------ CLOSE LOOP MOTION ---------------}
{initial sequence - set speed, absolute move, wait until move over}
//inputString := Format(sSetupMoveCommandAZ, [
// IntToStr(Round(MAX_Z_SPEED * Log10(ZStepper.Speed + 1))),
// IntToStr(MIN_Z_ACC * ZStepper.Speed),
// IntToStr(MIN_Z_DEC * ZStepper.Speed),
// IntToStr(stepsToMoveZ)]);
//DMCCommand(controllerHandle, PChar(inputstring), PChar(outputString), 128);
//inputString := sMoveCompleteZ;
//jdz - no need for this line?
//repeat until DMCWaitForMotionComplete(controllerHandle, PChar(inputstring), FALSE) = 0;
{correction until ~ 1 um}
{update position in user interface}
Delay(GALIL_READ_DELAY); {wait 100 ms}
GetZ(ZStepper.fzPosition);
Synchronize(UpdateUserInterfaceZ);
end;
GALIL_SET_TO_RELATIVE_Z, GALIL_SET_TO_RELATIVE_Z_NO_UPDATE {GALIL_SHIFT_BY_Z not used}:
begin
//jdp - note, this is the call that is made
// when a user presses a move stage button (in Z)
{convert from microns to steps}
stepsToMoveZ := Round(GALIL_STEPPER_RESOLUTION_Z * GalilParam1);
{------------ CLOSE LOOP MOTION ---------------}
{initial sequence - set speed, relative move, wait until move over}
inputString := Format(sSetupMoveCommandRZ, [
IntToStr(Round(MAX_Z_SPEED * Log10(ZStepper.Speed + 1))),
IntToStr(MIN_Z_ACC * ZStepper.Speed),
IntToStr(MIN_Z_DEC * ZStepper.Speed),
IntToStr(stepsToMoveZ)]);
DMCCommand(controllerHandle, PChar(inputstring), PChar(outputString), 128);
inputString := sMoveCompleteZ;
//repeat until DMCWaitForMotionComplete(controllerHandle, PChar(inputstring), FALSE) = 0;
{correction until ~ 1 um}
{update position in user interface}
//Delay(GALIL_READ_DELAY); {wait 100 ms}
if GalilAction <> GALIL_SET_TO_RELATIVE_Z_NO_UPDATE then
begin
WaitForMotionComplete;
Delay(GALIL_READ_DELAY); // make sure motion is completely settled
GetZ(ZStepper.fzPosition);
end;
Synchronize(UpdateUserInterfaceZ);
end;
GALIL_GET_XY, GALIL_READ_XY:
begin
GetXY(XYTable.fXPosition, XYTable.fYPosition);
Synchronize(UpdateUserInterfaceXY);
end;
GALIL_SET_XY, GALIL_MOVE_TO_XY:
begin
// note - stepsToMoveX should be changed to uses GALIL_ENCODER_RESOLUTION_XY,
// but this function is not currently called (can be called from the script)
{convert from microns to steps = 16/5 * (10 * positioninmicrons - initialposition) / 10}
stepsToMoveX := initialCounts[0] - Muldiv(16, Round(10 * GalilParam1) - InitialPositions[0], 50);
stepsToMoveY := initialCounts[1] - Muldiv(16, Round(10 * GalilParam2) - InitialPositions[1], 50);
{------------ CLOSE LOOP MOTION ---------------}
{initial sequence - brakes off, set speed, relative move, wait until move over}
inputString := Format(sSetupMoveCommandAXY, [
IntToStr(Round(MAX_XY_SPEED * Log10(XYTable.Speed + 1))),
IntToStr(Round(MAX_XY_SPEED * Log10(XYTable.Speed + 1))),
IntToStr(MIN_XY_ACC * XYTable.Speed),
IntToStr(MIN_XY_ACC * XYTable.Speed),
IntToStr(MIN_XY_DEC * XYTable.Speed),
IntToStr(MIN_XY_DEC * XYTable.Speed),
IntToStr(stepsToMoveX),
IntToStr(stepsToMoveY)]);
DMCCommand(controllerHandle, PChar(inputstring), PChar(outputString), 128);
inputString := sMoveCompleteXY;
repeat until DMCWaitForMotionComplete(controllerHandle, PChar(inputstring), FALSE) = 0;
{correction until ~ 1 um}
{update position in user interface}
Delay(GALIL_READ_DELAY); {wait 100 ms}
GetXY(XYTable.fXPosition, XYTable.fYPosition);
Synchronize(UpdateUserInterfaceXY);
end;
GALIL_SET_TO_RELATIVE_XY, GALIL_SHIFT_BY_XY:
begin
//jdp - note, this is the call that is made
// when a user presses a move stage button (in X or Y)
{convert from microns to steps}
stepsToMoveX := Round(GALIL_STEPPER_RESOLUTION_XY * GalilParam1);
stepsToMoveY := Round(GALIL_STEPPER_RESOLUTION_XY * GalilParam2);
{------------ CLOSE LOOP MOTION ---------------}
{initial sequence - brakes off, set speed, relative move, wait until move over}
inputString := Format(sSetupMoveCommandRXY, [
IntToStr(Round(MAX_XY_SPEED * Log10(XYTable.Speed + 1))),
IntToStr(Round(MAX_XY_SPEED * Log10(XYTable.Speed + 1))),
IntToStr(MIN_XY_ACC * XYTable.Speed),
IntToStr(MIN_XY_ACC * XYTable.Speed),
IntToStr(MIN_XY_DEC * XYTable.Speed),
IntToStr(MIN_XY_DEC * XYTable.Speed),
IntToStr(stepsToMoveX),
IntToStr(stepsToMoveY)]);
DMCCommand(controllerHandle, PChar(inputstring), PChar(outputString), 128);
inputString := sMoveCompleteXY;
//repeat until DMCWaitForMotionComplete(controllerHandle, PChar(inputstring), FALSE) = 0;
WaitForMotionComplete;
{update position in user interface}
Delay(GALIL_READ_DELAY); {wait 100 ms}
GetXY(XYTable.fXPosition, XYTable.fYPosition);
Synchronize(UpdateUserInterfaceXY);
end;
GALIL_FAST_STACK:
begin
// find the speed before the fast stack, and save it to a string
inputString := 'MG _SPZ';
DMCCommand(controllerHandle, PChar(inputstring), PChar(outputString), 128);
speedBeforeFastStackZ := Copy(outputString,1, Pos(':', outputString)-3);
//speedBeforeFastStackZ := outputString;
//messageBox(0,pchar(speedBeforeFastStackZ),'',0);
// find the original position before the fast stack, and save it to a string
inputString := 'MG _TDZ';
DMCCommand(controllerHandle, PChar(inputstring), PChar(outputString), 128);
posBeforeFastStackCountsZ := Copy(outputString,1, Pos(':', outputString)-3);
//messageBox(0,pchar(posBeforeFastStackCountsZ),'',0);
// speed comes from slider on user interface
// this is a number from 1-60, which is effectively um / s
inputString := Format(sSetZSpeed,[IntToStr(Round(fastStackSpeed * GALIL_STEPPER_RESOLUTION_Z))]);
DMCCommand(controllerHandle, PChar(inputstring), PChar(outputString), 128);
//MessageBox(0,PAnsiChar(inputString),'',0);
{convert from microns to steps}
stepsToMoveZ := Round(GALIL_STEPPER_RESOLUTION_Z * fastStackDistance); //jdz move 10 mils
stepsToMoveZafterFastStack := -stepsToMoveZ;
inputString := Format(sFastStackMoveRZ, [IntToStr(stepsToMoveZ)]);
DMCCommand(controllerHandle, PChar(inputstring), PChar(outputString), 128);
//DMCWaitForMotionComplete(controllerHandle, 'Z', FALSE);
// move back, and wait until done
//inputString := Format(sFastStackMoveRZ, [IntToStr(-stepsToMoveZ)]);
//DMCCommand(controllerHandle, PChar(inputstring), PChar(outputString), 128);
//DMCWaitForMotionComplete(controllerHandle, 'Z', FALSE);
//messageBox(0,PAnsiChar(FloatToStr(fastStackDistance)),'distance',0);
//jdz - disable this, because the controller should not wait until move
// has ended (rather, should adjust laser power instead
//inputString := sMoveCompleteZ;
//repeat Delay(10) until DMCWaitForMotionComplete(controllerHandle, PChar(inputstring), FALSE) = 0;
// this controls the return position
//ZStepper.ZPosition := ZStepper.ZPosition + GalilParam1;
dmc40.FastStackCallback;
end;
GALIL_COMMAND:
//DMCCommand(controllerHandle, PChar(inputstring), PChar(outputString), 64);
DMCCommand(controllerHandle, PChar(GalilCommandString), PChar(outputString), 64);
end;
finally
GalilAction := GALIL_NO_ACTION;
xyTable.Busy := False;
zStepper.Busy := False;
end;
end; // end loop over not Terminated
Destroy; // (Destroy must be called explicitly)
end;
constructor TGalilThread.Create(CreateSuspended: boolean);
begin
inherited Create(CreateSuspended);
FreeOnTerminate := True;
end;
destructor TGalilThread.Destroy;
begin
UnloadGalilLibrary;
inherited Destroy;
end;
end.
Raw
Gamma Frame
unit Gammafrmu;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons, ComCtrls, ExtCtrls, mpFileu;
type
TGammaFrm = class(TForm)
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
CheckBox1: TCheckBox;
TrackBar1: TTrackBar;
TrackBar2: TTrackBar;
Label1: TLabel;
Label2: TLabel;
Bevel1: TBevel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
RadioButton1: TRadioButton;
RadioButton2: TRadioButton;
RadioButton3: TRadioButton;
RadioButton4: TRadioButton;
procedure FormPaint(Sender: TObject);
procedure TrackBar1Change(Sender: TObject);
procedure TrackBar2Change(Sender: TObject);
procedure RadioButton1Click(Sender: TObject);
private
{ Private declarations }
histoRect: TRect;
oldBlackSliderPos, oldWhiteSliderPos: integer;
procedure DrawBlackLevelLine(sliderPos: integer);
procedure DrawHistogram;
procedure DrawWhiteLevelLine(sliderPos: integer);
public
{ Public declarations }
bInitializing: boolean;
mpFile: TMPFile;
procedure InitGUI(afile: TMPFile);
function SelectedCh: integer;
end;
var
GammaFrm: TGammaFrm;
implementation
{$R *.DFM}
const
BORDER_OFFSET = 12;
BIN_SIZE = 128; {for histogram}
procedure TGammaFrm.DrawBlackLevelLine(sliderPos: integer);
var linePos: integer;
begin
Canvas.Pen.Color := clRed;
Canvas.Pen.Width := 1;
Canvas.Pen.Style := psSolid;
Canvas.Pen.Mode := pmXor;
linePos := histoRect.Left + Muldiv(sliderPos, histoRect.Right - histoRect.Left,
2047 + 128);
Canvas.MoveTo(linePos, histoRect.Top);
Canvas.LineTo(linePos, histoRect.Bottom);
oldBlackSliderPos := sliderPos;
end;
procedure TGammaFrm.DrawHistogram;
var histogram: array of integer;
chIndex, i, maxValue, barValue, leftRect, rightRect: integer;
barRect: TRect;
begin
Canvas.Brush.Color := clWhite;
Canvas.FillRect(histoRect);
// Get the histogram
chIndex := SelectedCh;
SetLength(histogram, 2048 div BIN_SIZE + 1);
(mpFile.Frames[mpFile.ActiveFrameIndex].channels[chIndex] as TVideoFrame).
GetProfile(BIN_SIZE, histogram);
maxValue := 0;
for i := 0 to 2048 div BIN_SIZE do
if histogram[i] > maxValue then maxValue := histogram[i];
// Draws the rectangles
Canvas.Brush.Color := clBlack;
for i := 0 to 2048 div BIN_SIZE do
begin
barValue := histoRect.Bottom - Muldiv(histogram[i],
histoRect.Bottom - histoRect.Top, maxValue);
leftRect := histoRect.Left + Muldiv(i, histoRect.Right - histoRect.Left,
2048 div BIN_SIZE + 1);
rightRect := histoRect.Left + Muldiv(i + 1, histoRect.Right - histoRect.Left,
2048 div BIN_SIZE + 1) - 1;
barRect := Rect(leftRect, barValue, rightRect, histoRect.Bottom);
Canvas.FillRect(barRect);
end;
end;
procedure TGammaFrm.DrawWhiteLevelLine(sliderPos: integer);
var linePos: integer;
begin
Canvas.Pen.Color := clRed;
Canvas.Pen.Width := 1;
Canvas.Pen.Style := psSolid;
Canvas.Pen.Mode := pmXor;
linePos := histoRect.Left + Muldiv(sliderPos, histoRect.Right - histoRect.Left,
2047 + 128);
Canvas.MoveTo(linePos, histoRect.Top);
Canvas.LineTo(linePos, histoRect.Bottom);
oldWhiteSliderPos := sliderPos;
end;
procedure TGammaFrm.FormPaint(Sender: TObject);
begin
histoRect := Rect(BORDER_OFFSET, TrackBar1.Top + TrackBar1.Height,
ClientWidth - BORDER_OFFSET, TrackBar2.Top - 1);
DrawHistogram;
DrawBlackLevelLine(TrackBar1.Position);
DrawWhiteLevelLine(TrackBar2.Position);
end;
procedure TGammaFrm.TrackBar1Change(Sender: TObject);
begin
if bInitializing then Exit;
Label1.Caption := 'Black Level = ' + IntToStr(TrackBar1.Position - 128);
DrawBlackLevelLine(oldBlackSliderPos);
DrawBlackLevelLine(TrackBar1.Position);
end;
procedure TGammaFrm.TrackBar2Change(Sender: TObject);
begin
if bInitializing then Exit;
Label1.Caption := 'White Level = ' + IntToStr(TrackBar2.Position - 128);
DrawWhiteLevelLine(oldWhiteSliderPos);
DrawWhiteLevelLine(TrackBar2.Position);
end;
procedure TGammaFrm.RadioButton1Click(Sender: TObject);
begin
DrawHistogram;
DrawBlackLevelLine(TrackBar1.Position);
DrawWhiteLevelLine(TrackBar2.Position);
end;
procedure TGammaFrm.InitGUI(afile: TMPFile);
begin
with afile do
begin
RadioButton1.Checked := (DefaultVideoChannel = 0);
RadioButton2.Checked := (DefaultVideoChannel = 1);
RadioButton3.Checked := (DefaultVideoChannel = 2);
RadioButton4.Checked := (DefaultVideoChannel = 3);
if VideoChCount = 1 then
begin
RadioButton1.Enabled := False;
RadioButton2.Enabled := False;
RadioButton3.Enabled := False;
RadioButton4.Enabled := False;
end
else
begin
RadioButton1.Enabled := ChEnabled[0];
RadioButton2.Enabled := ChEnabled[1];
RadioButton3.Enabled := ChEnabled[2];
RadioButton4.Enabled := ChEnabled[3];
end;
end;
end;
function TGammaFrm.SelectedCh: integer;
begin
if RadioButton1.Checked then
Result := 0
else if RadioButton2.Checked then
Result := 1
else if RadioButton3.Checked then
Result := 2
else if RadioButton4.Checked then
Result := 3
else
Result := 0;
end;
end.
Raw
hardware configuration
unit hardconfig;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons, Spin, ComCtrls, ExtCtrls, MPUnit, Mainfrm, Mask;
type
THardConfigDlg = class(TForm)
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
PageControl1: TPageControl;
TabSheet1: TTabSheet;
GroupBox1: TGroupBox;
GroupBox2: TGroupBox;
Label2: TLabel;
TabSheet2: TTabSheet;
TabSheet3: TTabSheet;
ComboBox1: TComboBox;
GroupBox3: TGroupBox;
RadioButton4: TRadioButton;
RadioButton5: TRadioButton;
RadioButton6: TRadioButton;
CheckBox2: TCheckBox;
CheckBox3: TCheckBox;
ComboBox3: TComboBox;
ComboBox4: TComboBox;
TabSheet4: TTabSheet;
GroupBox4: TGroupBox;
GroupBox5: TGroupBox;
RadioButton7: TRadioButton;
RadioButton8: TRadioButton;
RadioButton9: TRadioButton;
ComboBox5: TComboBox;
ComboBox6: TComboBox;
Label5: TLabel;
Label6: TLabel;
GroupBox7: TGroupBox;
Label7: TLabel;
Label8: TLabel;
RadioButton12: TRadioButton;
RadioButton13: TRadioButton;
RadioButton14: TRadioButton;
ComboBox7: TComboBox;
ComboBox8: TComboBox;
Label9: TLabel;
Label10: TLabel;
GroupBox8: TGroupBox;
Label11: TLabel;
ComboBox9: TComboBox;
GroupBox9: TGroupBox;
CheckBox5: TCheckBox;
Label4: TLabel;
ComboBox10: TComboBox;
CheckBox4: TCheckBox;
RadioButton3: TRadioButton;
RadioButton16: TRadioButton;
RadioButton17: TRadioButton;
Bevel2: TBevel;
Bevel4: TBevel;
Bevel5: TBevel;
Bevel6: TBevel;
Label14: TLabel;
Label15: TLabel;
Label16: TLabel;
Bevel7: TBevel;
Bevel8: TBevel;
RadioButton10: TRadioButton;
TabSheet5: TTabSheet;
Edit1: TEdit;
Label18: TLabel;
Label19: TLabel;
TabSheet6: TTabSheet;
RadioButton11: TRadioButton;
RadioButton15: TRadioButton;
Label23: TLabel;
Label24: TLabel;
Label25: TLabel;
Label26: TLabel;
Edit2: TEdit;
Edit3: TEdit;
Edit4: TEdit;
Label27: TLabel;
Edit5: TEdit;
Label28: TLabel;
Label29: TLabel;
Label30: TLabel;
Label31: TLabel;
Label32: TLabel;
Label33: TLabel;
Label34: TLabel;
Label35: TLabel;
Label36: TLabel;
Label37: TLabel;
Edit6: TEdit;
Edit7: TEdit;
Edit8: TEdit;
Edit9: TEdit;
CheckBox6: TCheckBox;
CheckBox7: TCheckBox;
CheckBox8: TCheckBox;
CheckBox9: TCheckBox;
CheckBox10: TCheckBox;
CheckBox11: TCheckBox;
CheckBox12: TCheckBox;
Label38: TLabel;
SpinEdit2: TSpinEdit;
Label39: TLabel;
SpinEdit3: TSpinEdit;
GroupBox6: TGroupBox;
Label40: TLabel;
ComboBox15: TComboBox;
CheckBox13: TCheckBox;
TabSheet7: TTabSheet;
GroupBox10: TGroupBox;
RadioButton20: TRadioButton;
RadioButton21: TRadioButton;
GroupBox11: TGroupBox;
Label41: TLabel;
ComboBox16: TComboBox;
RadioButton22: TRadioButton;
Label12: TLabel;
MaskEdit1: TMaskEdit;
Label17: TLabel;
Edit10: TEdit;
Bevel12: TBevel;
CheckBox14: TCheckBox;
GroupBox12: TGroupBox;
Label13: TLabel;
ComboBox11: TComboBox;
CheckBox15: TCheckBox;
GroupBox13: TGroupBox;
RadioButton1: TRadioButton;
Bevel1: TBevel;
Label1: TLabel;
RadioButton2: TRadioButton;
ComboBox2: TComboBox;
CheckBox1: TCheckBox;
Label3: TLabel;
SpinEdit1: TSpinEdit;
GroupBox14: TGroupBox;
CheckBox16: TCheckBox;
RadioButton23: TRadioButton;
Bevel3: TBevel;
RadioButton24: TRadioButton;
CheckBox17: TCheckBox;
Edit11: TEdit;
RadioButton18: TRadioButton;
RadioButton19: TRadioButton;
Edit12: TEdit;
procedure FormShow(Sender: TObject);
procedure CheckBox4Click(Sender: TObject);
procedure RadioButton2Click(Sender: TObject);
procedure RadioButton13Click(Sender: TObject);
procedure RadioButton8Click(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure RadioButton4Click(Sender: TObject);
procedure CheckBox14Click(Sender: TObject);
procedure CheckBox13Click(Sender: TObject);
procedure CheckBox15Click(Sender: TObject);
private
{ Private declarations }
procedure OnXYControllerChosen;
public
{ Public declarations }
end;
var
HardConfigDlg: THardConfigDlg;
implementation
{$R *.DFM}
uses MPdevices;
function BaudToItemIndex(baud: integer): integer;
begin
case baud of
2400: Result := 0;
4800: Result := 1;
9600: Result := 2;
19200: Result := 3;
38400: Result := 4;
57600: Result := 5;
115200: Result := 6;
else Result := 2;
end;
end;
function ItemIndexToBaud(ii: integer): integer;
begin
case ii of
0: Result := 2400;
1: Result := 4800;
2: Result := 9600;
3: Result := 19200;
4: Result := 38400;
5: Result := 57600;
6: Result := 115200;
else Result := 9600;
end;
end;
procedure THardConfigDlg.OnXYControllerChosen;
begin
if RadioButton4.Checked then
{XY not installed}
begin
ComboBox3.Enabled := False;
ComboBox4.Enabled := False;
RadioButton3.Enabled := True;
RadioButton16.Enabled := True;
{we want to make sure that we don't have incompatible choices}
if RadioButton10.Checked then
begin
RadioButton10.Checked := False;
RadioButton3.Checked := True;
end;
RadioButton10.Enabled := False;
end
else if RadioButton5.Checked then
{NEAT 300}
begin
ComboBox3.Enabled := True;
ComboBox4.Enabled := True;
RadioButton3.Enabled := True;
RadioButton16.Enabled := True;
RadioButton10.Enabled := False;
{we want to make sure that we don't have incompatible choices}
if RadioButton10.Checked then
begin
RadioButton10.Checked := False;
RadioButton3.Checked := True;
end;
end
else if RadioButton17.Checked then
{MP285}
begin
ComboBox3.Enabled := True;
ComboBox4.Enabled := True;
RadioButton3.Enabled := False;
RadioButton16.Enabled := False;
RadioButton10.Checked := True;
end
else if RadioButton6.Checked then
{ESP300}
begin
ComboBox3.Enabled := True;
ComboBox4.Enabled := True;
RadioButton3.Enabled := False;
RadioButton16.Enabled := False;
RadioButton10.Checked := True;
end
else if RadioButton22.Checked then
begin {XPS controller}
ComboBox3.Enabled := False;
ComboBox4.Enabled := False;
RadioButton3.Enabled := False;
RadioButton16.Enabled := False;
RadioButton10.Checked := True;
end
else if RadioButton23.Checked then
begin {Galil controller}
ComboBox3.Enabled := True;
ComboBox4.Enabled := True;
RadioButton3.Enabled := False;
RadioButton16.Enabled := False;
RadioButton10.Checked := True;
end;
Edit10.Enabled := RadioButton22.Checked;
MaskEdit1.Enabled := RadioButton22.Checked;
Label38.Visible := RadioButton17.Checked;
SpinEdit2.Visible := RadioButton17.Checked;
end;
procedure THardConfigDlg.FormShow(Sender: TObject);
begin
ComboBox1.ItemIndex := multifunctionBoard.BoardIndex - 1;
CheckBox4.Checked := analogOutputBoard.Installed;
ComboBox9.ItemIndex := analogOutputBoard.BoardIndex - 1;
ComboBox9.Enabled := CheckBox4.Checked;
CheckBox13.Checked := opticsOutputBoard.Installed;
ComboBox15.ItemIndex := opticsOutputBoard.BoardIndex - 1;
ComboBox15.Enabled := CheckBox13.Checked;
CheckBox15.Checked := PhotonCountingBoard.Installed;
ComboBox11.ItemIndex := PhotonCountingBoard.BoardIndex - 1;
ComboBox11.Enabled := CheckBox15.Checked;
CheckBox5.Checked := multifunctionBoard.LogicLow;
ComboBox10.ItemIndex := multifunctionBoard.TTLTriggerPFILine;
RadioButton1.Checked := laserShutter.AnalogBoardControlsShutter;
RadioButton2.Checked := not RadioButton1.Checked;
CheckBox16.Checked := multifunctionBoard.bInvertPreamps;
ComboBox2.ItemIndex := laserShutter.multifunctionDIOIndex;
ComboBox2.Enabled := RadioButton2.Checked;
CheckBox1.Checked := laserShutter.CloseAfterSection;
SpinEdit1.Value := laserShutter.openDelay;
case xydeviceType of
XY_NOT_INSTALLED: RadioButton4.Checked := True;
XY_NEAT300: RadioButton5.Checked := True;
XY_MP285: RadioButton17.Checked := True;
XY_ESP300: RadioButton6.Checked := True;
XY_XPS: RadioButton22.Checked := True;
XY_GALIL: RadioButton23.Checked := True;
else RadioButton4.Checked := True;
end;
MaskEdit1.Text := XPS_IP;
Edit10.Text := XPS_GroupName;
ComboBox3.ItemIndex := XYTable.COMPort - 1;
ComboBox4.ItemIndex := BaudToItemIndex(XYTable.COMSpeed);
ComboBox3.Enabled := not RadioButton4.Checked;
ComboBox4.Enabled := not RadioButton4.Checked;
CheckBox3.Checked := XYTable.InvertX;
CheckBox2.Checked := XYTable.InvertY;
CheckBox6.Checked := ZStepper.InvertZ;
SpinEdit2.Value := micromanipulators[1].xyzReadDelay;
SpinEdit3.Value := micromanipulators[1].mmReadDelay;
OnXYControllerChosen;
{ ComboBox11.ItemIndex := ZStepper.COMPort - 1;
ComboBox12.ItemIndex := BaudToItemIndex(ZStepper.COMSpeed);}
case mmDeviceType[1] of
0: RadioButton12.Checked := True;
1: RadioButton13.Checked := True;
2: RadioButton14.Checked := True;
else RadioButton12.Checked := True;
end;
ComboBox7.ItemIndex := micromanipulators[1].COMPort - 1;
ComboBox8.ItemIndex := BaudToItemIndex(micromanipulators[1].COMSpeed);
ComboBox7.Enabled := RadioButton13.Checked;
ComboBox8.Enabled := RadioButton13.Checked;
case mmDeviceType[2] of
0: RadioButton7.Checked := True;
1: RadioButton8.Checked := True;
2: RadioButton9.Checked := True;
else RadioButton7.Checked := True;
end;
ComboBox5.ItemIndex := micromanipulators[2].COMPort - 1;
ComboBox6.ItemIndex := BaudToItemIndex(micromanipulators[2].COMSpeed);
ComboBox5.Enabled := RadioButton8.Checked;
ComboBox6.Enabled := RadioButton8.Checked;
CheckBox7.Checked := micromanipulators[1].InvertX;
CheckBox8.Checked := micromanipulators[1].InvertY;
CheckBox9.Checked := micromanipulators[1].InvertZ;
CheckBox10.Checked := micromanipulators[2].InvertX;
CheckBox11.Checked := micromanipulators[2].InvertY;
CheckBox12.Checked := micromanipulators[2].InvertZ;
CheckBox14.Checked := (Mainform.engine.MaxMirrorVoltage >= 5.0);
Edit1.Text := FloatToStr(Mainform.engine.MaxMirrorVoltage);
CheckBox17.Checked := Mainform.engine.OverrideMirrorFrequency;
case laserControlType of
LASER_NOT_INSTALLED: RadioButton11.Checked := True;
LASER_Kim_Zhang: RadioButton15.Checked := True;
LASER_MAI_TAI_0: RadioButton18.Checked := True;
LASER_MAI_TAI_1: RadioButton19.Checked := True;
end;
Edit2.Text := FloatToStr(laserControl.incA);
Edit3.Text := FloatToStr(laserControl.incB);
Edit4.Text := FloatToStr(laserControl.incC);
Edit5.Text := FloatToStr(laserControl.incD);
Edit6.Text := FloatToStr(laserControl.decA);
Edit7.Text := FloatToStr(laserControl.decB);
Edit8.Text := FloatToStr(laserControl.decC);
Edit9.Text := FloatToStr(laserControl.decD);
// ComboBox13.ItemIndex := laserControl.COMPort - 1;
// ComboBox14.ItemIndex := BaudToItemIndex(laserControl.COMSpeed);
if zPiezoType = ZPIEZO_NONE then
RadioButton20.Checked := True
else if zPiezoType = ZPIEZO_MIPOS100 then
RadioButton21.Checked := True
else
RadioButton24.Checked := True;
ComboBox16.ItemIndex := zPiezoOutChannel;
end;
procedure THardConfigDlg.CheckBox4Click(Sender: TObject);
begin
ComboBox9.Enabled := CheckBox4.Checked;
end;
procedure THardConfigDlg.RadioButton2Click(Sender: TObject);
begin
ComboBox2.Enabled := RadioButton2.Checked;
end;
procedure THardConfigDlg.RadioButton13Click(Sender: TObject);
begin
ComboBox7.Enabled := RadioButton13.Checked;
ComboBox8.Enabled := RadioButton13.Checked;
end;
procedure THardConfigDlg.RadioButton8Click(Sender: TObject);
begin
ComboBox5.Enabled := RadioButton8.Checked;
ComboBox6.Enabled := RadioButton8.Checked;
end;
procedure THardConfigDlg.BitBtn1Click(Sender: TObject);
var newVoltage, maxVoltage: double; I : double ;
begin
ModalResult := mrNone;
multifunctionBoard.BoardIndex := ComboBox1.ItemIndex + 1 ;
analogOutputBoard.Installed := CheckBox4.Checked;
analogOutputBoard.BoardIndex := ComboBox9.ItemIndex + 1;
opticsOutputBoard.Installed := CheckBox13.Checked;
opticsOutputBoard.BoardIndex := ComboBox15.ItemIndex + 1;
PhotonCountingBoard.Installed := CheckBox15.Checked;
PhotonCountingBoard.BoardIndex := ComboBox11.ItemIndex + 1;
multifunctionBoard.LogicLow := CheckBox5.Checked;
multifunctionBoard.TTLTriggerPFILine := ComboBox10.ItemIndex;
multifunctionBoard.bInvertPreamps := CheckBox16.Checked;
laserShutter.AnalogBoardControlsShutter := RadioButton1.Checked;
laserShutter.multifunctionDIOIndex := ComboBox2.ItemIndex;
laserShutter.CloseAfterSection := CheckBox1.Checked;
laserShutter.openDelay := SpinEdit1.Value;
if RadioButton11.Checked then
laserControlType := LASER_NOT_INSTALLED
else if RadioButton15.Checked then
laserControlType := LASER_Kim_Zhang
else if RadioButton18.Checked then
laserControlType := LASER_MAI_TAI_0
else if RadioButton19.Checked then
laserControlType := LASER_MAI_TAI_1;
laserControl.incA := StrToFloat(Edit2.Text);
laserControl.incB := StrToFloat(Edit3.Text);
laserControl.incC := StrToFloat(Edit4.Text);
laserControl.incD := StrToFloat(Edit5.Text);
laserControl.decA := StrToFloat(Edit6.Text);
laserControl.decB := StrToFloat(Edit7.Text);
laserControl.decC := StrToFloat(Edit8.Text);
laserControl.decD := StrToFloat(Edit9.Text);
// end;
// procedure TAnalogStimFrm.SpeedButton1Click(Sender: TObject);
// for I := 0 to List.Count - 1 do
if RadioButton18.Checked then
analogOutputBoard.AnalogOut(1, StrToFloat(Edit11.Text))
else if RadioButton19.Checked then
analogOutputBoard.AnalogOut(1, StrToFloat(Edit12.Text)/10);
// 10v to 100%
//
// laserControl.COMPort := ComboBox13.ItemIndex + 1;
// laserControl.COMSpeed := ItemIndexToBaud(ComboBox14.ItemIndex);
{X-Y-Z page}
XYTable.COMPort := ComboBox3.ItemIndex + 1;
XYTable.COMSpeed := ItemIndexToBaud(ComboBox4.ItemIndex);
XYTable.InvertX := CheckBox3.Checked;
XYTable.InvertY := CheckBox2.Checked;
ZStepper.InvertZ := CheckBox6.Checked;
if RadioButton4.Checked then xydeviceType := XY_NOT_INSTALLED
else if RadioButton5.Checked then xydeviceType := XY_NEAT300
else if RadioButton17.Checked then
begin
xydeviceType := XY_MP285;
zStepperDeviceType := Z_MP285;
ZStepper.COMPort := XYTable.COMPort;
ZStepper.COMSpeed := XYTable.COMSpeed;
end
else if RadioButton6.Checked then
begin
xydeviceType := XY_ESP300;
zStepperDeviceType := Z_ESP300;
ZStepper.COMPort := XYTable.COMPort;
ZStepper.COMSpeed := XYTable.COMSpeed;
end
else if RadioButton22.Checked then {XPS}
begin
xydeviceType := XY_XPS;
zStepperDeviceType := Z_XPS;
ZStepper.COMPort := XYTable.COMPort;
ZStepper.COMSpeed := XYTable.COMSpeed;
end
else if RadioButton23.Checked then {GALIL}
begin
xydeviceType := XY_GALIL;
zStepperDeviceType := Z_GALIL;
ZStepper.COMPort := XYTable.COMPort;
ZStepper.COMSpeed := XYTable.COMSpeed;
end;
XPS_IP := MaskEdit1.Text;
XPS_GroupName := Edit10.Text;
micromanipulators[1].xyzReadDelay := SpinEdit2.Value;
micromanipulators[1].mmReadDelay := SpinEdit3.Value;
if RadioButton3.Checked then zStepperDeviceType := Z_NOT_INSTALLED
else if RadioButton16.Checked then zStepperDeviceType := Z_EARL;
{ else
begin
ZStepper.COMPort := ComboBox11.ItemIndex + 1;
ZStepper.COMSpeed := ItemIndexToBaud(ComboBox12.ItemIndex);
end;}
if RadioButton12.Checked then mmDeviceType[1] := 0
else if RadioButton13.Checked then mmDeviceType[1] := 1
else if RadioButton14.Checked then mmDeviceType[1] := 2;
micromanipulators[1].COMPort := ComboBox7.ItemIndex + 1;
micromanipulators[1].COMSpeed := ItemIndexToBaud(ComboBox8.ItemIndex);
if RadioButton7.Checked then mmDeviceType[2] := 0
else if RadioButton8.Checked then mmDeviceType[2] := 1
else if RadioButton9.Checked then mmDeviceType[2] := 2;
micromanipulators[2].COMPort := ComboBox5.ItemIndex + 1;
micromanipulators[2].COMSpeed := ItemIndexToBaud(ComboBox6.ItemIndex);
micromanipulators[1].InvertX := CheckBox7.Checked;
micromanipulators[1].InvertY := CheckBox8.Checked;
micromanipulators[1].InvertZ := CheckBox9.Checked;
micromanipulators[2].InvertX := CheckBox10.Checked;
micromanipulators[2].InvertY := CheckBox11.Checked;
micromanipulators[2].InvertZ := CheckBox12.Checked;
if RadioButton20.Checked then
zPiezoType := ZPIEZO_NONE
else if RadioButton21.Checked then
zPiezoType := ZPIEZO_MIPOS100
else
zPiezoType := ZPIEZO_PIFOC725;
zPiezoOutChannel := ComboBox16.ItemIndex;
ComboBox16.ItemIndex := zPiezoOutChannel;
if CheckBox14.Checked then maxVoltage := 10.0 else maxVoltage := 5.0;
newVoltage := StrToFloat(Edit1.Text);
if (newVoltage > 0) and (newVoltage <= maxVoltage) then
begin
if Mainform.engine.MaxMirrorVoltage <> newVoltage then
MessageDlg('You must restart MPScan to apply the new Maximal Mirror Command Voltage value.', mtInformation, [mbOK], 0);
Mainform.engine.MaxMirrorVoltage := newVoltage;
ModalResult := mrOK;
end
else
MessageDlg('Invalid value for the Maximal Mirror Command Voltage.', mtError, [mbOK], 0);
if CheckBox17.Checked then
begin
if not Mainform.engine.OverrideMirrorFrequency then
begin
if MessageDlg('Are you sure you want to override mirror frequency limit?', mtInformation, [mbYes, mbNo], 0) = mrYes then
Mainform.engine.OverrideMirrorFrequency := CheckBox17.Checked;
end;
end
else
Mainform.engine.OverrideMirrorFrequency := CheckBox17.Checked;
end;
procedure THardConfigDlg.RadioButton4Click(Sender: TObject);
begin
OnXYControllerChosen;
end;
procedure THardConfigDlg.CheckBox14Click(Sender: TObject);
begin
if CheckBox14.Checked then
MessageDlg('You can now enter a maximal voltage up to 10 V.', mtWarning, [mbOK], 0)
else
MessageDlg('Maximal voltage is restricted to 5 V.', mtInformation, [mbOK], 0);
end;
procedure THardConfigDlg.CheckBox13Click(Sender: TObject);
begin
ComboBox15.Enabled := CheckBox13.Checked;
end;
procedure THardConfigDlg.CheckBox15Click(Sender: TObject);
begin
ComboBox11.Enabled := CheckBox15.Checked;
end;
end.
Raw
Horizon
unit Horzbaru;
interface
uses
Messages, Windows, Classes, Graphics, Controls, Menus, ExtCtrls;
type
{integer = integer;}
TDrawTickEvent = procedure(Sender: TObject) of object;
TCustomTrack = class(TCustomControl)
private
fOwnerDrawTicks: TDrawTickEvent;
protected
procedure DrawTicks;
public
procedure DrawMajorTicks(pos: integer); virtual; abstract;
procedure DrawMinorTicks(pos: integer); virtual; abstract;
{callback to draw ticks}
property OwnerDrawTicks: TDrawTickEvent write fOwnerDrawTicks;
end;
THorzTrackBar = class(TCustomTrack)
private
fCursor: TObject;
fMax, fMin, fPosition, fPageSize: integer;
fScreenPos: integer;
fSliding: boolean;
fCursorRect: TRect;
{in screen coordinates:
fMajorTickInterval: interval between major ticks > 0
fFirstMajorTickPos: position of the lowest first tick mark > 0
cMinorTickCount: number of minor ticks between each tick mark > 0}
{fMajorTickInterval, fFirstMajorTickPos, fMinorTickCount: integer;}
fDitherBmp, fCursorBmp, fMaskBmp, fBackgroundBmp: TBitmap;
fOnChange: TNotifyEvent;
function CursorToScreen( Value: integer): integer;
function ScreenToCursor( Value: integer): integer;
function LimitPosition( Value: integer): integer; {clips value to the control}
procedure SetMax( Value : integer );
procedure SetMin( Value : integer );
procedure SetPosition( Value : integer );
function GetScreenPosition: integer;
procedure SetScreenPosition( Value : integer );
procedure LoadThumbBitmaps;
procedure UpdateDitherBitmap;
procedure DrawTrack;
procedure DrawCursor;
procedure WMGetDlgCode( var Msg : TWMGetDlgCode ); message wm_GetDlgCode;
procedure CMEnabledChanged( var Msg : TMessage ); message cm_EnabledChanged;
protected
procedure Paint; override;
procedure Change; dynamic;
procedure DoEnter; override;
procedure DoExit; override;
procedure KeyDown( var Key : Word; Shift : TShiftState ); override;
procedure MouseDown( Button : TMouseButton; Shift : TShiftState; X, Y : Integer ); override;
procedure MouseMove( Shift : TShiftState; X, Y : Integer ); override;
procedure MouseUp( Button : TMouseButton; Shift : TShiftState; X, Y : Integer ); override;
public
constructor Create( AOwner : TComponent ); override;
constructor CreateInCursor( AOwner: TComponent; theCursor: TObject);
destructor Destroy; override;
function CursorVisible: boolean;
procedure SetParams(theMax, theMin, thePos: integer);
procedure DrawMajorTicks(pos: integer); override;
procedure DrawMinorTicks(pos: integer); override;
published
property ScreenPos: integer read GetScreenPosition write SetScreenPosition;
property Max : integer read fMax write SetMax default 999;
property Min : integer read fMin write SetMin default 0;
property PageSize : integer read fPageSize write fPageSize default 50;
property Position : integer read fPosition write SetPosition;
property OnChange : TNotifyEvent read fOnChange write fOnChange;
{ Inherited Properties & Events }
property Color;
property DragCursor;
property DragMode;
property Enabled;
property HelpContext;
property Hint;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property TabOrder;
property TabStop default True;
property Visible;
property OnClick;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
end;
procedure Register;
implementation
uses SysUtils {, cursorsu, viewdata};
{$R CURSORS}
procedure TCustomTrack.DrawTicks;
begin
{calls the owner to draw ticks}
if Assigned(fOwnerDrawTicks) then fOwnerDrawTicks(Self);
end;
procedure THorzTrackBar.DrawMajorTicks(pos: integer);
begin
with Canvas do
begin
Pen.Color := clBlack;
Pen.Width := 1;
MoveTo(pos, 8);
LineTo(pos, 17);
end;
end;
procedure THorzTrackBar.DrawMinorTicks(pos: integer);
begin
with Canvas do
begin
Pen.Color := clBlack;
Pen.Width := 1;
MoveTo(pos, 12);
LineTo(pos, 17);
end;
end;
function THorzTrackBar.CursorToScreen( Value: integer): integer;
begin
Result := Muldiv(Value - fMin, ClientWidth - 1, fMax - fMin);
if Result < 0 then Result := 0;
if Result >= ClientWidth then Result := ClientWidth - 1;
end;
function THorzTrackBar.ScreenToCursor( Value: integer): integer;
begin
Result := fMin + Muldiv(Value, fMax - fMin, ClientWidth - 1);
end;
function THorzTrackBar.LimitPosition( Value: integer): integer;
begin
Result :=Value;
if Result > fMax then Result := fMax;
if Result < fMin then Result := fMin;
end;
procedure THorzTrackBar.SetMax( Value : integer );
begin
if value <> fMax then
begin
fMax := Value;
if fPosition > fMax then screenPos := CursorToScreen(fMax);
fPageSize := (fMax - fMin) div 20;
Invalidate;
end;
end;
procedure THorzTrackBar.SetMin( Value : integer );
begin
if value <> fMin then
begin
fMin := Value;
if fPosition < fMin then screenPos := CursorToScreen(fMin);
fPageSize := (fMax - fMin) div 20;
Invalidate;
end;
end;
procedure THorzTrackBar.SetPosition( Value : integer );
begin
if value <> fPosition then
begin
fPosition := Value;
if csDesigning in ComponentState then
Invalidate
else
begin
{ Erase old thumb image by drawing background bitmap }
Canvas.Draw( fCursorRect.Left, fCursorRect.Top, FBackgroundBmp );
DrawCursor; { Draw thumb at new location }
Change; { Trigger Change event }
end;
end;
end;
function THorzTrackBar.GetScreenPosition;
begin
Result := CursorToScreen(fPosition);
end;
procedure THorzTrackBar.SetScreenPosition( Value : Integer );
begin
if Value < 0 then Value := 0;
if Value >= ClientWidth then Value := ClientWidth - 1;
fPosition := ScreenToCursor(Value);
Invalidate;
end;
procedure THorzTrackBar.LoadThumbBitmaps;
const
hCursor: PChar = 'HCURSOR';
hMask: PChar = 'HMASK';
begin
fCursorBmp.Handle := LoadBitmap(hInstance, hCursor);
fMaskBmp.Handle := LoadBitmap(hInstance, hMask);
end;
procedure THorzTrackBar.UpdateDitherBitmap;
var
i, j : integer;
begin
with fDitherBmp.Canvas do
begin
Brush.Color := clWhite;
FillRect( Rect( 0, 0, fDitherBmp.Width, fDitherBmp.Height ) );
for i := 0 to 7 do
for j := 0 to 7 do
if ( i + j ) mod 2 <> 0 then
Pixels[ i, j ] := clSilver;
end;
end;
procedure THorzTrackBar.DrawTrack;
begin
Canvas.Brush.Color := clWhite;
if not Enabled then
Canvas.Brush.Bitmap := fDitherBmp;
Canvas.FillRect(ClientRect);
end;
procedure THorzTrackBar.DrawCursor;
var
workBmp : TBitmap;
workRct : TRect;
begin
fScreenPos := CursorToScreen(fPosition);
fCursorRect := Rect(fScreenPos - 7, 1, fScreenPos + 8, 16);
fBackgroundBmp.Width := 15;
fBackgroundBmp.Height := 15;
fBackgroundBmp.Canvas.CopyRect( Rect(0, 0, fCursorBmp.Width, fCursorBmp.Height),
Canvas, fCursorRect );
workBmp := TBitmap.Create;
try
workBmp.Height := fCursorBmp.Height;
workBmp.Width := fCursorBmp.Width;
workRct := Rect( 0, 0, fCursorBmp.Width, fCursorBmp.Height);
workBmp.Canvas.CopyMode := cmSrcCopy;
workBmp.Canvas.CopyRect( WorkRct, fBackgroundBmp.Canvas, workRct );
workBmp.Canvas.CopyMode := cmSrcAnd;
workBmp.Canvas.CopyRect( WorkRct, fMaskBmp.Canvas, WorkRct );
workBmp.Canvas.CopyMode := cmSrcPaint;
WorkBmp.Canvas.CopyRect( WorkRct, fCursorBmp.Canvas, WorkRct );
if not Enabled then
begin
WorkBmp.Canvas.Brush.Bitmap := fDitherBmp;
WorkBmp.Canvas.FloodFill( WorkRct.Right - 3, WorkRct.Bottom - 3,
clSilver, fsSurface );
end;
Canvas.CopyRect( fCursorRect, WorkBmp.Canvas, WorkRct );
finally
workBmp.Free;
end;
end;
procedure THorzTrackBar.WMGetDlgCode( var Msg : TWMGetDlgCode );
begin
inherited;
Msg.Result := dlgc_WantArrows;
end;
procedure THorzTrackBar.CMEnabledChanged( var Msg : TMessage );
begin
inherited;
Invalidate;
end;
procedure THorzTrackBar.Paint;
begin
with Canvas do
begin
DrawTrack;
DrawTicks;
DrawCursor;
end;
end;
procedure THorzTrackBar.Change;
begin
if Assigned( FOnChange ) then FOnChange( Self );
end;
procedure THorzTrackBar.DoEnter;
begin
inherited DoEnter;
Refresh;
end;
procedure THorzTrackBar.DoExit;
begin
inherited DoExit;
Refresh;
end;
procedure THorzTrackBar.KeyDown( var Key : Word; Shift : TShiftState );
begin
inherited KeyDown( Key, Shift );
case Key of
vk_Prior:
Position := LimitPosition(fPosition + fPageSize);
vk_Next:
Position := LimitPosition(fPosition - FPageSize);
vk_End:
Position := fMin;
vk_Home:
Position := fMax;
vk_Left:
if fPosition > fMin then Position := LimitPosition(fPosition - 1);
vk_Up:
if fPosition < fMax then Position := LimitPosition(fPosition + 1);
vk_Right:
if fPosition < fMax then Position := LimitPosition(fPosition + 1);
vk_Down:
if fPosition > fMin then Position := LimitPosition(fPosition - 1);
end;
end;
procedure THorzTrackBar.MouseDown( Button : TMouseButton; Shift : TShiftState; X, Y : Integer );
begin
inherited MouseDown( Button, Shift, X, Y );
SetFocus;
if ( Button = mbLeft ) and PtInRect( fCursorRect, Point( X, Y ) ) then
fSliding := True
else
begin
if ScreenToCursor(X) < fPosition then
Position := LimitPosition(fPosition - fPageSize)
else
Position := LimitPosition(fPosition + fPageSize);
end;
end;
procedure THorzTrackBar.MouseMove( Shift : TShiftState; X, Y : Integer );
var { h : Integer;}
p: integer;
begin
inherited MouseMove( Shift, X, Y );
if PtInRect( FCursorRect, Point( X, Y ) ) then
Cursor := crSizeWE
else
Cursor := crDefault;
if fSliding then
begin
{ h := ClientWidth - 7;}
p:= fMin + Muldiv(X, fMax - fMin, ClientWidth - 1);
if p > fMax then p := fMax;
if p < fMin then p := fMin;
Position := p;
end;
end;
procedure THorzTrackBar.MouseUp( Button : TMouseButton; Shift : TShiftState; X, Y : Integer );
begin
inherited MouseUp( Button, Shift, X, Y );
if ( Button = mbLeft ) then fSliding := False;
end;
constructor THorzTrackBar.Create( AOwner : TComponent );
begin
inherited Create( AOwner );
Width := 200;
Height := 17;
fMin := 0;
fMax := 65536;
fPosition := 0;
fPageSize := 65536 div 20;
fSliding := False;
fCursorBmp := TBitmap.Create;
fCursorBmp.Width := 16;
fCursorBmp.Height := 16;
fMaskBmp := TBitmap.Create;
fBackgroundBmp := TBitmap.Create;
fDitherBmp := TBitmap.Create;
fDitherBmp.Width := 8;
fDitherBmp.Height := 8;
UpdateDitherBitmap;
LoadThumbBitmaps;
end;
constructor THorzTrackBar.CreateInCursor( AOwner: TComponent; theCursor: TObject);
begin
Create(AOwner);
fCursor := theCursor;
end;
destructor THorzTrackBar.Destroy;
begin
FreeAndNil(fCursorBmp);
FreeAndNil(fMaskBmp);
FreeAndNil(fBackgroundBmp);
FreeAndNil(fDitherBmp);
inherited Destroy;
end;
function THorzTrackBar.CursorVisible: boolean;
begin
if (fPosition <= fMax) and (fPosition >= fMin) then Result := True else Result := False;
end;
procedure THorzTrackBar.SetParams(theMax, theMin, thePos: integer);
begin
fMax := theMax;
fMin := theMin;
fPosition := thePos;
fPageSize := (fMax - fMin) div 20;
end;
procedure Register;
begin
RegisterComponents( 'Samples', [THorzTrackBar] );
end;
end.
Raw
LUT
unit lutdlgu;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Buttons, ExtCtrls, StdCtrls, ComCtrls, Spin, Vieweru, MPViewu;
type
TLUTDlg = class(TForm)
TabControl1: TTabControl;
GroupBox1: TGroupBox;
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
CheckBox3: TCheckBox;
PaintBox1: TPaintBox;
GroupBox2: TGroupBox;
SpeedButton1: TSpeedButton;
PaintBox2: TPaintBox;
GroupBox3: TGroupBox;
SpeedButton2: TSpeedButton;
PaintBox3: TPaintBox;
GroupBox4: TGroupBox;
SpeedButton3: TSpeedButton;
PaintBox4: TPaintBox;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
SpinEdit1: TSpinEdit;
Label1: TLabel;
ColorDialog1: TColorDialog;
Label2: TLabel;
SpinEdit2: TSpinEdit;
procedure CheckBox1Click(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure TabControl1Change(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure SpeedButton3Click(Sender: TObject);
procedure PaintBox1Paint(Sender: TObject);
procedure PaintBox2Paint(Sender: TObject);
procedure PaintBox4Paint(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure PaintBox3Paint(Sender: TObject);
procedure SpinEdit2Change(Sender: TObject);
procedure TabControl1Changing(Sender: TObject;
var AllowChange: Boolean);
private
{ Private declarations }
bDontChange: boolean;
public
{ Public declarations }
dlgBaseColors: TBaseColorsArray;
dlgnegativeColors,
dlgmidRangeColors,
dlgmaxColors: TRangeColorsArray;
dlgMaxPixels: TMaxPixelsArray;
viewer: TViewerFrm;
end;
var
LUTDlg: TLUTDlg;
implementation
{$R *.DFM}
uses Mainfrm;
procedure TLUTDlg.CheckBox1Click(Sender: TObject);
var r,g,b: Byte;
begin
r := 0; g := 0; b := 0;
if not bDontChange then
begin
dlgBaseColors[TabControl1.TabIndex, 0] := CheckBox1.Checked;
dlgBaseColors[TabControl1.TabIndex, 1] := CheckBox2.Checked;
dlgBaseColors[TabControl1.TabIndex, 2] := CheckBox3.Checked;
end;
if SpinEdit1.Value >= SpinEdit2.Value then
PaintBox1.Color := RGB(dlgmaxColors[TabControl1.TabIndex].rgbtRed,
dlgmaxColors[TabControl1.TabIndex].rgbtGreen,
dlgmaxColors[TabControl1.TabIndex].rgbtBlue)
else
begin
if CheckBox1.Checked then r := Muldiv($FF, SpinEdit1.Value, SpinEdit2.Value - 1);
if CheckBox2.Checked then g := Muldiv($FF, SpinEdit1.Value, SpinEdit2.Value - 1);
if CheckBox3.Checked then b := Muldiv($FF, SpinEdit1.Value, SpinEdit2.Value - 1);
PaintBox1.Color := RGB(r, g, b);
end;
PaintBox1.Invalidate;
end;
procedure TLUTDlg.SpeedButton1Click(Sender: TObject);
begin
ColorDialog1.Color := RGB( dlgnegativeColors[TabControl1.TabIndex].rgbtRed,
dlgnegativeColors[TabControl1.TabIndex].rgbtGreen,
dlgnegativeColors[TabControl1.TabIndex].rgbtBlue);
if ColorDialog1.Execute then
begin
{TRGBQuad has order of R, G, B reversed}
dlgnegativeColors[TabControl1.TabIndex].rgbtRed := TRGBQuad(ColorDialog1.Color).rgbBlue;
dlgnegativeColors[TabControl1.TabIndex].rgbtGreen := TRGBQuad(ColorDialog1.Color).rgbGreen;
dlgnegativeColors[TabControl1.TabIndex].rgbtBlue := TRGBQuad(ColorDialog1.Color).rgbRed;
PaintBox2.Color := ColorDialog1.Color;
PaintBox2.Invalidate;
end;
end;
procedure TLUTDlg.BitBtn1Click(Sender: TObject);
var i: integer;
begin
if (dlgBaseColors[0, 0] or dlgBaseColors[0, 1] or dlgBaseColors[0, 2] = False) or
(dlgBaseColors[1, 0] or dlgBaseColors[1, 1] or dlgBaseColors[1, 2] = False) or
(dlgBaseColors[2, 0] or dlgBaseColors[2, 1] or dlgBaseColors[2, 2] = False) or
(dlgBaseColors[3, 0] or dlgBaseColors[3, 1] or dlgBaseColors[3, 2] = False) then
begin
MessageDlg('Base colors cannot be black.', mtError, [mbOK], 0);
ModalResult := mrNone;
end
else
with Viewer.mpFile do
begin
BaseColors := dlgBaseColors;
negativeColors := dlgnegativeColors;
midRangeColors := dlgmidRangeColors;
maxColors := dlgmaxColors;
for i := 0 to MAX_CH - 1 do
if dlgMaxPixels[i] > 2047 then dlgMaxPixels[i] := 2047
else if dlgMaxPixels[i] < 50 then dlgMaxPixels[i] := 50;
maxPixels := dlgMaxPixels;
end;
end;
procedure TLUTDlg.TabControl1Change(Sender: TObject);
begin
bDontChange := True;
CheckBox1.Checked := dlgBaseColors[TabControl1.TabIndex, 0];
CheckBox2.Checked := dlgBaseColors[TabControl1.TabIndex, 1];
CheckBox3.Checked := dlgBaseColors[TabControl1.TabIndex, 2];
PaintBox2.Color := RGB( dlgnegativeColors[TabControl1.TabIndex].rgbtRed,
dlgnegativeColors[TabControl1.TabIndex].rgbtGreen,
dlgnegativeColors[TabControl1.TabIndex].rgbtBlue);
PaintBox3.Color := RGB( dlgmidRangeColors[TabControl1.TabIndex].rgbtRed,
dlgmidRangeColors[TabControl1.TabIndex].rgbtGreen,
dlgmidRangeColors[TabControl1.TabIndex].rgbtBlue);
PaintBox4.Color := RGB( dlgmaxColors[TabControl1.TabIndex].rgbtRed,
dlgmaxColors[TabControl1.TabIndex].rgbtGreen,
dlgmaxColors[TabControl1.TabIndex].rgbtBlue);
SpinEdit2.Value := dlgMaxPixels[TabControl1.TabIndex];
CheckBox1Click(nil);
PaintBox1.Invalidate;
PaintBox2.Invalidate;
PaintBox3.Invalidate;
PaintBox4.Invalidate;
bDontChange := False;
end;
procedure TLUTDlg.SpeedButton2Click(Sender: TObject);
begin
ColorDialog1.Color := RGB( dlgmidRangeColors[TabControl1.TabIndex].rgbtRed,
dlgmidRangeColors[TabControl1.TabIndex].rgbtGreen,
dlgmidRangeColors[TabControl1.TabIndex].rgbtBlue);
if ColorDialog1.Execute then
begin
dlgmidRangeColors[TabControl1.TabIndex].rgbtRed := TRGBQuad(ColorDialog1.Color).rgbBlue;
dlgmidRangeColors[TabControl1.TabIndex].rgbtGreen := TRGBQuad(ColorDialog1.Color).rgbGreen;
dlgmidRangeColors[TabControl1.TabIndex].rgbtBlue := TRGBQuad(ColorDialog1.Color).rgbRed;
PaintBox3.Color := ColorDialog1.Color;
PaintBox3.Invalidate;
end;
end;
procedure TLUTDlg.SpeedButton3Click(Sender: TObject);
begin
ColorDialog1.Color := RGB( dlgmaxColors[TabControl1.TabIndex].rgbtRed,
dlgmaxColors[TabControl1.TabIndex].rgbtGreen,
dlgmaxColors[TabControl1.TabIndex].rgbtBlue);
if ColorDialog1.Execute then
begin
dlgmaxColors[TabControl1.TabIndex].rgbtRed := TRGBQuad(ColorDialog1.Color).rgbBlue;
dlgmaxColors[TabControl1.TabIndex].rgbtGreen := TRGBQuad(ColorDialog1.Color).rgbGreen;
dlgmaxColors[TabControl1.TabIndex].rgbtBlue := TRGBQuad(ColorDialog1.Color).rgbRed;
PaintBox4.Color := ColorDialog1.Color;
PaintBox4.Invalidate;
end;
end;
procedure TLUTDlg.PaintBox1Paint(Sender: TObject);
begin
with PaintBox1, PaintBox1.Canvas do
begin
Brush.Color := Color;
FillRect(ClientRect);
end;
end;
procedure TLUTDlg.PaintBox2Paint(Sender: TObject);
begin
with PaintBox2, PaintBox2.Canvas do
begin
Brush.Color := Color;
FillRect(ClientRect);
end;
end;
procedure TLUTDlg.PaintBox4Paint(Sender: TObject);
begin
with PaintBox4, PaintBox4.Canvas do
begin
Brush.Color := Color;
FillRect(ClientRect);
end;
end;
procedure TLUTDlg.FormShow(Sender: TObject);
begin
TabControl1.TabIndex := Viewer.MPFile.DefaultVideoChannel;
TabControl1Change(nil);
CheckBox1Click(nil);
end;
procedure TLUTDlg.PaintBox3Paint(Sender: TObject);
begin
with PaintBox3, PaintBox3.Canvas do
begin
Brush.Color := Color;
FillRect(ClientRect);
end;
end;
procedure TLUTDlg.SpinEdit2Change(Sender: TObject);
begin
dlgMaxPixels[TabControl1.TabIndex] := SpinEdit2.Value;
CheckBox1Click(nil);
end;
procedure TLUTDlg.TabControl1Changing(Sender: TObject;
var AllowChange: Boolean);
begin
dlgBaseColors[TabControl1.TabIndex, 0] := CheckBox1.Checked;
dlgBaseColors[TabControl1.TabIndex, 1] := CheckBox2.Checked;
dlgBaseColors[TabControl1.TabIndex, 2] := CheckBox3.Checked;
end;
end.
Raw
Main Frame
unit mainfrm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Menus, ImgList, ToolWin, ComCtrls, mpviewu, Buttons, ExtCtrls, mpfileu,
COMObj, ActiveX, ShellAPI, ROIFrmu;
const
WM_POSTSHOWMSG = WM_APP + 400;
type
TMainform = class(TForm)
MainMenu1: TMainMenu;
File1: TMenuItem;
NewFile1: TMenuItem;
OpenFile1: TMenuItem;
SaveFileAs1: TMenuItem;
N1: TMenuItem;
Close1: TMenuItem;
N2: TMenuItem;
Exit1: TMenuItem;
Help1: TMenuItem;
About1: TMenuItem;
FileInformation1: TMenuItem;
N5: TMenuItem;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
Panel1: TPanel;
SpeedButton1: TSpeedButton;
Settings1: TMenuItem;
Options1: TMenuItem;
StopMatlab1: TMenuItem;
SpeedButton2: TSpeedButton;
Window1: TMenuItem;
N3: TMenuItem;
ArrangeAll1: TMenuItem;
Cascade1: TMenuItem;
Tile1: TMenuItem;
FileAs1: TMenuItem;
AnalogDataAs1: TMenuItem;
ROIDataAs1: TMenuItem;
Scripting1: TMenuItem;
ShowScriptingEnvironment1: TMenuItem;
Panel2: TPanel;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure OpenFile1Click(Sender: TObject);
procedure NewFile1Click(Sender: TObject);
procedure SaveFileAs1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
procedure About1Click(Sender: TObject);
procedure Options1Click(Sender: TObject);
procedure StopMatlab1Click(Sender: TObject);
procedure FileInformation1Click(Sender: TObject);
procedure Close1Click(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure Exit1Click(Sender: TObject);
procedure Tile1Click(Sender: TObject);
procedure Cascade1Click(Sender: TObject);
procedure ArrangeAll1Click(Sender: TObject);
procedure AnalogDataAs1Click(Sender: TObject);
procedure ROIDataAs1Click(Sender: TObject);
private
{ Private declarations }
procedure InitializeColorTables;
function GetActiveFile: TObject; {returns the file associated with the MDI window}
public
{ Public declarations }
{24-bit gray scale or false color table}
grayScaleTable, falseColorTable: array[0..MAX_FALSE_COLORS-1] of TRGBTriple;
bAppClosing,
bBinaryOp,
bLocalMatlabServer: boolean;
remoteMatlabServer: string;
matlab : OleVariant;
fileList: TFileList;
procedure WMDROPFILES(var Message: TMessage); message WM_DROPFILES;
procedure WMPOSTSHOWMSG(var Message: TMessage); message WM_POSTSHOWMSG;
property activeFile: TObject read GetActiveFile;
end;
var
Mainform: TMainform;
implementation
{$R *.DFM}
uses RegStr, Registry, Optdlgu, Fileinfodlgu, vieweru, aboutdlgu, mconsolefrm, Math,
analogu, vfw, {Variants,} cpyanaldlgu, FileCtrl;
const
sSection = 'Application Settings';
sEntry = 'Position';
sDirectory = 'Data Directory';
sbLocalServer = 'Local Server';
sRemoteServerLocation = 'Remote Server';
sAppName = 'MPView';
{******************************** Private methods *****************************}
procedure TMainform.InitializeColorTables;
var i, n, g, r, b, offset: integer;
u: array of integer;
J: array[1..MAX_FALSE_COLORS,1..3] of integer;
begin
{gray scales}
for i := 0 to 2047 do
begin
grayScaleTable[i].rgbtBlue := i div 8;
grayScaleTable[i].rgbtGreen := i div 8;
grayScaleTable[i].rgbtRed := i div 8;
end;
{false colors}
n := ceil(MAX_FALSE_COLORS / 4);
SetLength(u, 3 * n - 1);
for i := 0 to n-1 do u[i] := Muldiv(255,i + 1,n);
for i := n to 2*n - 2 do u[i] := 255;
for i := 2*n - 1 to 3*n - 2 do u[i] := Muldiv(255, 3*n - i + 1, n);
if MAX_FALSE_COLORS mod 4 = 1 then g := -1 else g := 0;
g := g + ceil(n/2) + 1; {g[1..3 * n - 1]}
r := g + n;
b := g - n;
if b < 1 then offset := -b + 1 else offset := 0;
for i := 1 to MAX_FALSE_COLORS do
begin
J[i, 1] := 0;
J[i, 2] := 0;
J[i, 3] := 0;
end;
for i := 1 to MAX_FALSE_COLORS do
begin
if (i + r <= MAX_FALSE_COLORS) and (i < 3*n) then J[i + r ,1] := u[i-1];
if (i + g <= MAX_FALSE_COLORS) and (i < 3*n) then J[i + g, 2] := u[i-1];
if (i + offset <= 3*n - 1) then J[i,3] := u[i- 1 + offset];
end;
for i := 1 to MAX_FALSE_COLORS do
begin
if J[i, 1] > 255 then
J[i, 1] := 255;
if J[i, 2] > 255 then
J[i, 2] := 255;
if J[i, 3] > 255 then
J[i, 3] := 255;
end;
for i := 1 to MAX_FALSE_COLORS - 1 do
begin
falseColorTable[i].rgbtBlue := J[i+1,3];
falseColorTable[i].rgbtGreen := J[i+1,2];
falseColorTable[i].rgbtRed := J[i+1,1];
end;
falseColorTable[MAX_FALSE_COLORS - 1].rgbtBlue := 255;
falseColorTable[MAX_FALSE_COLORS - 1].rgbtGreen := 255;
falseColorTable[MAX_FALSE_COLORS - 1].rgbtRed := 255;
falseColorTable[0].rgbtBlue := 0;
falseColorTable[0].rgbtGreen := 0;
falseColorTable[0].rgbtRed := 0;
end;
function TMainform.GetActiveFile: TObject; {returns the file associated with the MDI window}
begin
Result := nil;
if MDIChildCount > 0 then
if MDIChildren[0] is TViewerFrm then
Result := (MDIChildren[0] as TViewerFrm).MPFile
else if MDIChildren[0] is TAnalogFrm then
Result := (MDIChildren[0] as TAnalogFrm).MPFile;
end;
{********************************* PUBLIC *************************************}
procedure TMainform.WMDROPFILES(var Message: TMessage);
var szFileName: array[0..255] of Char;
fileCount, i: integer;
s: string;
begin
fileCount := DragQueryFile(HDROP(Message.wParam), $FFFFFFFF, nil, 256);
try
if fileCount > 0 then
for i := 0 to fileCount - 1 do
if DragQueryFile(HDROP(Message.wParam), i, @szFileName, 256) > 0 then
begin
s := szFileName;
FileList.Open(s);
end;
finally
DragFinish(HDROP(Message.wParam));
end;
end;
procedure TMainform.WMPOSTSHOWMSG(var Message: TMessage);
begin
if ParamCount > 0 then
FileList.Open(ParamStr(1))
else
OpenFile1Click(nil);
end;
{**************************** CREATION - DESTRUCTION **************************}
procedure TMainform.FormCreate(Sender: TObject);
var reg: TRegistry;
keyName, keyValue: string;
TempKey: HKey;
Disposition: Integer;
begin
AVIFileInit;
InitializeColorTables;
fileList := TFileList.Create;
VariantInit(matlab);
{Associates file extension: CODE DOES NOT WORK}
{Opens root}
TempKey := 0;
keyName := '.mpd';
if RegCreateKeyEx(HKEY_CLASSES_ROOT, PChar(keyName), 0, nil, REG_OPTION_NON_VOLATILE,
KEY_ALL_ACCESS, nil, TempKey, @Disposition) = ERROR_SUCCESS then
begin
keyValue := 'MPView';
RegSetValue(TempKey, nil, REG_SZ, PChar(keyValue), Length(keyValue));
RegCloseKey(TempKey);
end;
TempKey := 0;
keyName := 'MPView';
if RegCreateKeyEx(HKEY_CLASSES_ROOT, PChar(keyName), 0, nil, REG_OPTION_NON_VOLATILE,
KEY_ALL_ACCESS, nil, TempKey, @Disposition) = ERROR_SUCCESS then
RegCloseKey(TempKey);
TempKey := 0;
keyName := 'MPView\DefaultIcon';
if RegCreateKeyEx(HKEY_CLASSES_ROOT, PChar(keyName), 0, nil, REG_OPTION_NON_VOLATILE,
KEY_ALL_ACCESS, nil, TempKey, @Disposition) = ERROR_SUCCESS then
begin
keyValue := ParamStr(0) + ',0';
RegSetValue(TempKey, nil, REG_SZ, PChar(keyValue), Length(keyValue));
RegCloseKey(TempKey);
end;
TempKey := 0;
keyName := 'MPView\Shell';
if RegCreateKeyEx(HKEY_CLASSES_ROOT, PChar(keyName), 0, nil, REG_OPTION_NON_VOLATILE,
KEY_ALL_ACCESS, nil, TempKey, @Disposition) = ERROR_SUCCESS then
RegCloseKey(TempKey);
TempKey := 0;
keyName := 'MPView\Shell\Open';
if RegCreateKeyEx(HKEY_CLASSES_ROOT, PChar(keyName), 0, nil, REG_OPTION_NON_VOLATILE,
KEY_ALL_ACCESS, nil, TempKey, @Disposition) = ERROR_SUCCESS then
begin
keyValue := '&Open';
RegSetValue(TempKey, nil, REG_SZ, PChar(keyValue), Length(keyValue));
RegCloseKey(TempKey);
end;
TempKey := 0;
keyName := 'MPView\Shell\Open\Command';
if RegCreateKeyEx(HKEY_CLASSES_ROOT, PChar(keyName), 0, nil, REG_OPTION_NON_VOLATILE,
KEY_ALL_ACCESS, nil, TempKey, @Disposition) = ERROR_SUCCESS then
begin
keyValue := ParamStr(0) + ' %1';
RegSetValue(TempKey, nil, REG_SZ, PChar(keyValue), Length(keyValue));
RegCloseKey(TempKey);
end;
reg := TRegistry.Create;
with reg do
try
RootKey := HKEY_CURRENT_USER;
if OpenKey('\Software\Microsoft\Windows\CurrentVersion\Extensions', True)
then if ReadString('MPD') = '' then
WriteString('MPD', ParamStr(0));
CloseKey;
finally
Free;
end;
{Drag and Drop}
DragAcceptFiles(Handle, True);
end;
procedure TMainform.FormShow(Sender: TObject);
var regini: TRegistryIniFile;
begin
regini := TRegistryIniFile.Create(sAppName);
with regini do
begin
FileList.dataDirectory := ExcludeTrailingBackslash(ReadString(sSection, sDirectory, ''));
bLocalMatlabServer := ReadBool(sSection, sbLocalServer, True);
remoteMatlabServer := ReadString(sSection, sRemoteServerLocation, '');
if not DirectoryExists(FileList.dataDirectory) then
fileList.dataDirectory := ExcludeTrailingBackslash(ExtractFilePath(ParamStr(0)));
RestorePosFromRegistry(self, regini, sSection, sEntry, True);
Free;
end;
PostMessage(Handle, WM_POSTSHOWMSG, 0, 0);
end;
procedure TMainform.FormClose(Sender: TObject; var Action: TCloseAction);
var regini: TRegistryIniFile;
begin
regini := TRegistryIniFile.Create(sAppName);
with regini do
begin
WriteBool(sSection, sbLocalServer, bLocalMatlabServer);
WriteString(sSection, sRemoteServerLocation, remoteMatlabServer);
WriteString(sSection, sDirectory, FileList.dataDirectory);
SavePosToRegistry(self, regini, sSection, sEntry);
Free;
end;
{Drag and Drop}
DragAcceptFiles(Handle, False);
end;
procedure TMainform.FormDestroy(Sender: TObject);
begin
fileList.Free;
AVIFileExit;
end;
{************************************ MENUS ***********************************}
procedure TMainform.NewFile1Click(Sender: TObject);
begin
if ActiveFile <> nil then
fileList.NewFile(ActiveFile as TMPFile);
end;
procedure TMainform.OpenFile1Click(Sender: TObject);
begin
OpenDialog1.InitialDir := ExcludeTrailingBackslash(FileList.dataDirectory);
if OpenDialog1.Execute then
FileList.Open(OpenDialog1.Filename);
end;
procedure TMainform.SaveFileAs1Click(Sender: TObject);
begin
if MDIChildCount > 0 then
if MDIChildren[0] is TViewerFrm then
if (MDIChildren[0] as TViewerFrm).mpFile.IsMemoryFile then
begin
if (MDIChildren[0] as TViewerFrm).mpFile.FrameCount > 0 then
begin
with SaveDialog1 do
begin
DefaultExt := 'MPD';
Filter := 'MPD Files (*.MPD)|*.MPD|All Files (*.*)|*.*';
Title := 'Save Workspace As';
end;
if SaveDialog1.Execute then
fileList.SaveFileAs
((MDIChildren[0] as TViewerFrm).MPFile, SaveDialog1.Filename);
end
else
MessageDlg('Workspace ' + (MDIChildren[0] as TViewerFrm).mpFile.Filename +
' has no frames to save.', mtInformation, [mbOK], 0);
end;
{ else if MDIChildren[0] is TAnalogFrm then
begin
end
else if MDIChildren[0] is TROIFrm then
begin
end; }
end;
procedure TMainform.AnalogDataAs1Click(Sender: TObject);
var fromFrame, toFrame: integer;
savedCursor: TCursor;
bASCII: boolean;
begin
if MDIChildCount > 0 then
if MDIChildren[0] is TAnalogFrm then
if (MDIChildren[0] as TAnalogFrm).mpFile.FrameCount > 0 then
begin
bASCII := (MessageDlg('Do you want to save the file as plain ASCII (Yes) or Unicode (No)?',
mtInformation, [mbYes, mbNo], 0)= mrYes);
{strange - "with" construct with CopyAnalogDlg or (MDIChildren[0] fail at run-time)}
CopyAnalogDlg.RadioButton1.Checked := (MDIChildren[0] as TAnalogFrm).mpFile.AnalogChEnabled[2];
CopyAnalogDlg.RadioButton1.Enabled := (MDIChildren[0] as TAnalogFrm).mpFile.AnalogChEnabled[2];
CopyAnalogDlg.RadioButton2.Checked := (MDIChildren[0] as TAnalogFrm).mpFile.AnalogChEnabled[3];
CopyAnalogDlg.RadioButton2.Enabled := (MDIChildren[0] as TAnalogFrm).mpFile.AnalogChEnabled[3];
CopyAnalogDlg.SpinEdit1.MaxValue := (MDIChildren[0] as TAnalogFrm).mpFile.FrameCount;
CopyAnalogDlg.SpinEdit1.Value := 1;
CopyAnalogDlg.SpinEdit2.MaxValue := (MDIChildren[0] as TAnalogFrm).mpFile.FrameCount;
CopyAnalogDlg.SpinEdit2.Value := (MDIChildren[0] as TAnalogFrm).mpFile.FrameCount;
if CopyAnalogDlg.ShowModal = mrOK then
begin
fromFrame := CopyAnalogDlg.SpinEdit1.Value - 1;
toFrame := CopyAnalogDlg.SpinEdit2.Value - 1;
if (fromFrame >= 0) and (fromFrame <= (MDIChildren[0] as TAnalogFrm).mpFile.FrameCount - 1) and
(toFrame >= 0) and (toFrame <= (MDIChildren[0] as TAnalogFrm).mpFile.FrameCount - 1) and
(fromFrame <= toFrame) then
begin
with SaveDialog1 do
begin
DefaultExt := 'TXT';
Filter := 'Text Files (*.TXT)|*.TXT|All Files (*.*)|*.*';
Title := 'Save Analog Data In Text File';
end;
if SaveDialog1.Execute then
begin
savedCursor := Screen.Cursor;
try
Screen.Cursor := crHourGlass;
(MDIChildren[0] as TAnalogFrm).mpFile.SaveChannelsToFile(bASCII,
SaveDialog1.Filename,
CopyAnalogDlg.RadioButton1.Checked and CopyAnalogDlg.RadioButton1.Enabled,
CopyAnalogDlg.RadioButton2.Checked and CopyAnalogDlg.RadioButton2.Enabled,
fromFrame, toFrame);
finally
Screen.Cursor := savedCursor;
end;
end;
end
else
MessageDlg('Invalid frame indices.', mtError, [mbOK], 0);
end; {showmodal}
end {frame count > 0}
else
MessageDlg('Analog Window ' + (MDIChildren[0] as TAnalogFrm).mpFile.Filename +
' has no data to save.', mtInformation, [mbOK], 0);
end;
procedure TMainform.About1Click(Sender: TObject);
begin
AboutDlg.ShowModal;
end;
procedure TMainform.Options1Click(Sender: TObject);
begin
if not VarIsEmpty(matlab) then Exit;
if OptDlg.ShowModal = mrOK then
try
Screen.Cursor := crHourGlass;
VariantInit(matlab);
if bLocalMatlabServer then
begin
matlab := CreateOLEObject('Matlab.Application');
matlab.Visible := 1;
end
else
matlab := CreateRemoteCOMObject(remoteMatlabServer, DIID_DIMLApp);
mconsole := Tmconsole.Create(self);
mconsole.Show;
finally
Screen.Cursor := crDefault;
end;
if VarIsEmpty(matlab) then
MessageDlg('MPView cannot start Matlab.', mtError, [mbOK], 0);
end;
procedure TMainform.StopMatlab1Click(Sender: TObject);
begin
if not(VarIsEmpty(matlab)) then
begin
VariantClear(matlab);
VariantInit(matlab);
mconsole.Close;
mconsole := nil;
end;
end;
procedure TMainform.FileInformation1Click(Sender: TObject);
begin
if ActiveFile <> nil then
begin
FileInfoDlg.Fill(ActiveFile as TMPFile);
FileInfoDlg.ShowModal;
end;
end;
procedure TMainform.Close1Click(Sender: TObject);
begin
if ActiveFile <> nil then
(ActiveFile as TMPFile).Close(self)
else
ActiveMDIChild.Close;
end;
procedure TMainform.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
bAppClosing := True;
end;
procedure TMainform.Exit1Click(Sender: TObject);
begin
Close;
end;
procedure TMainform.Tile1Click(Sender: TObject);
begin
Tile;
end;
procedure TMainform.Cascade1Click(Sender: TObject);
begin
Cascade;
end;
procedure TMainform.ArrangeAll1Click(Sender: TObject);
begin
ArrangeIcons;
end;
procedure TMainform.ROIDataAs1Click(Sender: TObject);
var savedCursor: TCursor;
bASCII: boolean;
padding: integer;
begin
if MDIChildCount > 0 then
if MDIChildren[0] is TROIFrm then
if (MDIChildren[0] as TROIFrm).toFrame - (MDIChildren[0] as TROIFrm).fromFrame > 0 then
begin
bASCII := (MessageDlg('Do you want to save the file as plain ASCII (Yes) or Unicode (No)?',
mtInformation, [mbYes, mbNo], 0)= mrYes);
if MessageDlg('Do you want to add extra data points between ROI values?', mtInformation,
[mbYes, mbNo], 0) = mrYes then
begin
try
padding := StrToInt(InputBox('Data Points Between ROI Values', 'Enter total data points', '1'));
except
padding := 0;
end;
end
else
padding := 1;
if (padding > 0) and (padding < 10000000) then
begin
with SaveDialog1 do
begin
DefaultExt := 'TXT';
Filter := 'Text Files (*.TXT)|*.TXT|All Files (*.*)|*.*';
Title := 'Save ROI Data In Text File';
end;
if SaveDialog1.Execute then
begin
savedCursor := Screen.Cursor;
try
Screen.Cursor := crHourGlass;
(MDIChildren[0] as TROIFrm).SaveDataToFile(bASCII, padding,
SaveDialog1.Filename);
finally
Screen.Cursor := savedCursor;
end;
end;
end
else
MessageDlg('Invalid padding value.', mtError, [mbOK], 0);
end {frame count > 0}
else
MessageDlg('ROI Window ' + MDIChildren[0].Caption +
' has no data to save.', mtInformation, [mbOK], 0);
end;
end.
Raw
mconsole frame
unit mconsolefrm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ActiveX, ComObj;
type
Tmconsole = class(TForm)
Memo1: TMemo;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
procedure Memo1KeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
private
{ Private declarations }
public
{ Public declarations }
end;
var
mconsole: Tmconsole;
implementation
uses mainfrm {, Variants};
{$R *.DFM}
procedure Tmconsole.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if not Mainform.bAppClosing then
begin
if not(VarIsEmpty(Mainform.matlab)) then
begin
VariantClear(Mainform.matlab);
VariantInit(Mainform.matlab);
end;
Action := caFree;
end;
end;
procedure Tmconsole.FormShow(Sender: TObject);
begin
Memo1.Lines.Add('Enter Matlab code after the prompt.');
Memo1.Text := Memo1.Text + '>';
Memo1.SelStart := Length(Memo1.Text); {sets before CR}
Memo1.SelLength := 0;
end;
procedure Tmconsole.Memo1KeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
var v: Variant;
s, sm: string;
i: integer;
begin
if Key = 13 {Line feed} then
begin
{look for line containing the last caret}
s := Memo1.Lines[Memo1.Lines.Count - 1];
if s[1] = '>' then
begin
{removes '>'}
sm := Copy(s, 2, Length(s) - 1);
v := sm; {prepares variant}
sm := VarToStr(Mainform.matlab.Execute(v));
{adds a CR before a LF}
s := '';
if Length(sm) > 0 then
for i := 1 to Length(sm) do
begin
if sm[i] = Chr(10) then s := s + Chr(13);
s := s + sm[i];
end;
Memo1.Lines.Add(s);
end;
Memo1.Text := Memo1.Text + '>';
Memo1.Refresh;
Memo1.SelStart := Length(Memo1.Text);
Memo1.SelLength := 0;
end;
end;
initialization
mconsole := nil;
end.
Raw
MP Device
unit mpdevices;
{ **************************************************************************** }
{*} {*}
{*} INTERFACE {*}
{* This unit abstracts the devices used to run the microscope. {*}
{ **************************************************************************** }
uses Classes, Windows, Controls, AnalogStimDef, MPUnit, AdPort, MPSCAN_PC_TLB, AutoXYTable,
AutoZStepper, AutoShutter, MMSystem, AutoLaser, XPSThreadU, GalilThreadU,
SysUtils, Messages;
const
// the number of steps sent to the galil is computed from
// (number of microns to move) * GALIL_STEPPER_RESOLUTION
GALIL_STEPPER_RESOLUTION_Z = 16/5; // 5 microns per 16 steps}
GALIL_STEPPER_RESOLUTION_XY = 3200/508; //3200/508; // RIG - 16/5 for L2 and L1 front rig, 3200/508 for L1 back rig
type
TDeviceState = (dsNotInstalled, dsInstalled, dsNotFound, dsDetected);
{generic callback to update user interface; used by slow devices (serial port based)}
// obsolete Dec 19 2005; TPositionCallback = procedure of Object;
TMPScanDevice = class
private
fDeviceState: TDeviceState;
function GetDeviceState: TDeviceState; virtual;
public
name: string;
procedure Connect; virtual;
property deviceStatus: TDeviceState read GetDeviceState;
end;
{******************************* NI-DAQ Board *********************************}
TNIDAQBoard = class(TMPScanDevice)
private
fDigitalPort: integer;
deviceCode: int16;
fbLogicLow: boolean;
function GetBoardIndex: integer; virtual;
procedure SetBoardIndex(newIndex: integer); virtual;
procedure SetDigitalPort(dioValue: integer);
public
procedure SetDigitalBit(bitIndex: integer; value: boolean); {takes into account logic}
property boardIndex: integer read GetBoardIndex write SetBoardIndex;
property DigitalPort: integer read fDigitalPort write SetDigitalPort;
end;
{TMultifunctionBoard is currently a PCI-6110E. It puts the 20 MHz clock and the
start of acquisition signals on RTSI lines 0 and 1}
TMultifunctionBoard = class(TNIDAQBoard)
private
function GetInvertPreamps: boolean;
function GetBoardIndex: integer; override;
function GetLogicLow: boolean;
function GetMaxAnalogOutDigitalValue: integer;
function GetTriggerLine: integer;
function GetPMTOffsets(chIndex: integer): int16;
function GetTTLTriggerPFILine: integer;
function GetT1(mirror: integer): integer;
function GetT2(mirror: integer): integer;
function GetDeltaT(mirror: integer): integer;
procedure SetInvertPreamps(value: boolean);
procedure SetBoardIndex(newIndex: integer); override;
procedure SetLogicLow(value: boolean);
procedure SetPMTOffsets(chIndex: integer; value: int16);
procedure SetTTLTriggerPFILine(lineIndex: integer);
procedure SetT1(mirror: integer; value: integer);
procedure SetT2(mirror: integer; value: integer);
procedure SetDeltaT(mirror: integer; value: integer);
public
{feedforward parameters}
procedure Connect; override;
constructor Create;
{original Earl Dolnick's design: all logic 1s are 0s on the bus}
property LogicLow: boolean read GetLogicLow write SetLogicLow;
property MaxAnalogOutDigitalValue: integer read GetMaxAnalogOutDigitalValue;
property PMTOffsets[chIndex: integer]: int16 read GetPMTOffsets write SetPMTOffsets;
{image acquisition TTL triggering}
property TTLTriggerPFILine: integer read GetTTLTriggerPFILine write SetTTLTriggerPFILine;
property TriggerLine: integer read GetTriggerLine; {returns code for PFI_X lines}
{feedforward mirror correction parameters}
property T1[mirror: integer]: integer read GetT1 write SetT1;
property T2[mirror: integer]: integer read GetT2 write SetT2;
property DeltaT[mirror: integer]: integer read GetDeltaT write SetDeltaT;
{added 12-11-07 for commercial PMT preamps that invert polarity}
property bInvertPreamps: boolean read GetInvertPreamps write SetInvertPreamps;
end;
{Takes care of analog stimulation output. To minize bus traffic during image
acquisition, analog stimulation pattern is pre-loaded to the analog output board
FIFO memory. Sets its own clock to RTSI_0 and start of data out to RTSI_1}
TAnalogOutputBoard = class(TNIDAQBoard)
private
fAnalogOutputEnabled: boolean;
fOutputRange: double;
cStimBufferSize: integer; {in samples}
pStimBuffer: TpFrameData;
fLoaded: boolean;
FIFOSampleCount: integer; {default: 8192}
procedure AllocateStimBuffer;
procedure DestroyStimBuffer;
function GetAnalogChConvFactors(chIndex: integer): double;
function GetAnalogChNames(chIndex: integer): string;
function GetAnalogChPrefixes(chIndex: integer): TPrefix;
function GetAnalogChUnits(chIndex: integer): string;
function GetAnalogChZeroOffset(chIndex: integer): double;
function GetBoardIndex: integer; override;
function GetInstalled: boolean; virtual;
function GetTotalSampleCount(const newParams: TAnalogStimRec): integer;
procedure ReloadStimParams;
procedure SetAnalogChConvFactors(chIndex: integer; value: double);
procedure SetAnalogChNames(chIndex: integer; value: string);
procedure SetAnalogChPrefixes(chIndex: integer; value: TPrefix);
procedure SetAnalogChUnits(chIndex: integer; value: string);
procedure SetAnalogChZeroOffset(chIndex: integer; value: double);
procedure SetAnalogOutputEnabled(newAnalogOut: boolean);
procedure SetBoardIndex(newIndex: integer); override;
procedure SetInstalled(value: boolean); virtual;
function ValidateStimParams(const newParams: TAnalogStimRec): boolean;
public
analogStimParams: TAnalogStimRec;
procedure AnalogOut(chIndex: integer; value: double);
function AnalogToDigital(chIndex: integer; value: double): int16;
procedure Connect; override;
function DigitalToAnalog(chIndex: integer; value: int16): double;
function LoadAnalogStimParams(const newParams: TAnalogStimRec): boolean;
function OpenAnalogStimulation(const stimFilename: string): boolean;
procedure SaveAnalogStimulation(const stimFilename: string);
procedure StartAnalogStimulation;
function StopAnalogStimulation: boolean; {returns True or False in incremental
incremental mode when another stimulation needs to be issued}
constructor Create;
destructor Destroy; override;
property AnalogOutputEnabled: boolean read fAnalogOutputEnabled write SetAnalogOutputEnabled;
property AnalogChConvFactors[chIndex: integer]: double read GetAnalogChConvFactors write SetAnalogChConvFactors;
property AnalogChNames[chIndex: integer]: string read GetAnalogChNames write SetAnalogChNames;
property AnalogChPrefixes[chIndex: integer]: TPrefix read GetAnalogChPrefixes write SetAnalogChPrefixes;
property AnalogChUnits[chIndex: integer]: string read GetAnalogChUnits write SetAnalogChUnits;
property AnalogChZeroOffsets[chIndex: integer]: double read GetAnalogChZeroOffset write SetAnalogChZeroOffset;
property Installed: boolean read GetInstalled write SetInstalled;
property Loaded: boolean read fLoaded;
property OutputRange: double read fOutputRange; {bipolar output = +/-OutputRange}
end;
{opticsOutputBoard provides up to 4 analog output channels to control the Z
piezo stepper, Pockels cell etc... 20 MHz time base provided via the RTSI bus;
All timings relative to the 20 MHz time base of the PCI-6110E.
Sets its own clock to RTSI_0 and start of data out to RTSI_1}
TOpticsOutputBoard = class(TAnalogOutputBoard)
private
function GetBoardIndex: integer; override;
function GetInstalled: boolean; override;
procedure SetBoardIndex(newIndex: integer); override;
procedure SetInstalled(value: boolean); override;
{*public
procedure AnalogOutF(chIndex: integer; value: double); *}
end;
{Uses RTSI_2 to get pixel clock}
TPhotonCountingBoard = class(TNIDAQBoard)
private
function GetBoardIndex: integer; override;
function GetInstalled: boolean;
procedure SetBoardIndex(newIndex: integer); override;
procedure SetInstalled(value: boolean);
public
procedure Connect; override;
constructor Create;
destructor Destroy; override;
property Installed: boolean read GetInstalled write SetInstalled;
end;
{******************************** Laser Shutter *******************************}
TLaserShutter = class(TMPScanDevice)
private
fbClosed: boolean;
function GetAnalogBoardControlsShutter: boolean;
function GetCloseAfterSection: boolean;
function GetMultifunctionDIOIndex: integer;
function GetOpenDelay: integer;
procedure SetAnalogBoardControlsShutter(value: boolean);
procedure SetCloseAfterSection(value: boolean);
procedure SetClosed(bClosed: boolean);
procedure SetMultifunctionDIOIndex(newIndex: integer);
procedure SetOpenDelay(newDelay: integer);
public
autoObject: IMPLaserShutter;
procedure Connect; override;
procedure OpenShutter;
procedure Wait(nms: integer);
constructor Create;
destructor Destroy; override;
property AnalogBoardControlsShutter: boolean read GetAnalogBoardControlsShutter
write SetAnalogBoardControlsShutter;
property Closed: boolean read fbClosed write SetClosed;
property CloseAfterSection: boolean read GetCloseAfterSection write SetCloseAfterSection;
property MultifunctionDIOIndex: integer read GetMultifunctionDIOIndex write SetmultifunctionDIOIndex;
property OpenDelay: integer read GetOpenDelay write SetOpenDelay;
end;
{
TOriginalShutter = class(TLaserShutter)
procedure SetDeviceState(newState: TDeviceState); override;
end;
}
{******************************* Z-stepper table ******************************}
TZStepper = class(TMPScanDevice)
private
bTimerActive: boolean;
zTimer: MMResult;
minTimerResolution, maxTimerResolution: integer;
curFastRepeatCount: integer;
bFastScanInProgress, fBusy: boolean;
startFastScanPosition,
fStepSize: double;
function GetCOMPort: integer;
function GetCOMSpeed: integer;
function GetInvertZ: boolean;
function GetSpeed: integer;
procedure SetCOMPort(value: integer);
procedure SetCOMSpeed(value: integer);
procedure SetInvertZ(value: boolean);
procedure SetSpeed(newspeed: integer); virtual;
procedure SetZPosition(newPos: double);
public
fZPosition: double;
autoObject: IMPZStepper;
procedure OnMoveStarted; {updates user interface}
procedure OnMoveFinished;
{asynchronous calls}
{1: slowest, 10: fastest}
procedure GetZ(var newZ: double); virtual;
procedure MoveToRelativeZ(newDeltaZ: double); virtual;
procedure SetZ(var newZ: double); virtual;
{retuns the time (in s) it takes to do zTravel at speedIndex (1..60)}
function TravelTime(zTravel: integer; speedIndex: integer): double; virtual;
procedure StartFastScan; virtual;
procedure StopFastScan; virtual;
procedure StopMove;
{synchronous calls: MoveToZ, ReadZ, ShiftByZ}
procedure MoveToZ(newZ: double); virtual;
function ReadZ: double; virtual;
procedure ShiftByZ(deltaZ: double); virtual;
property Busy: boolean read fBusy write fBusy;
property COMPort: integer read GetCOMPort write SetCOMPort;
property COMSpeed: integer read GetCOMSpeed write SetCOMSpeed;
property MovingZ: boolean read fBusy;
property FastScanInProgress: boolean read bFastScanInProgress;
property InvertZ: boolean read GetInvertZ write SetInvertZ; {inverts z motion}
property ZPosition: double read fZPosition write SetZPosition;
property stepSize: double read fStepSize; {in microns}
property Speed: integer read GetSpeed write SetSpeed;
constructor Create;
destructor Destroy; override;
end;
type
TZSequence = array[0..1] of int16; {Z-axis up or down sequence}
TZSequenceArray = array[0..1000000] of TZSequence;
TpZSequenceArray = ^TZSequenceArray;
TEarlStepper = class(TZStepper)
private
zPattern: int32;
curZsequenceCount, zsequenceCount: integer;
procedure SetSpeed(newspeed: integer); override;
public
procedure Connect; override;
procedure GetZ(var newZ: double); override;
procedure MoveToRelativeZ(newDeltaZ: double); override;
procedure SetZ(var newZ: double); override;
function TravelTime(zTravel: integer; speedIndex: integer): double; override;
procedure MoveToZ(newZ: double); override;
function ReadZ: double; override;
procedure ShiftByZ(deltaZ: double); override;
procedure StartFastScan; override;
procedure StopFastScan; override;
constructor Create;
destructor Destroy; override;
end;
{Object created when microscope uses a MP285 micromanipulator to move the XYZ stage.
Module hardconfig enforces the rule that if MP285 is used for XY, MP285 is used for Z.
A TZMP285 and a TXYMP285 objects are instantiated. They all refer to the TXYZMP285 object
(not seen by user)
}
TZMP285 = class(TZStepper)
function GetDeviceState: TDeviceState; override;
procedure SetSpeed(speedIndex: integer); override;
public
procedure Connect; override;
procedure GetZ(var newZ: double); override;
procedure MoveToRelativeZ(newDeltaZ: double); override;
procedure SetZ(var newZ: double); override;
procedure MoveToZ(newZ: double); override;
function ReadZ: double; override;
procedure ShiftByZ(deltaZ: double); override;
function TravelTime(zTravel: integer; speedIndex: integer): double; override;
procedure StartFastScan; override;
procedure StopFastScan; override;
constructor Create;
destructor Destroy; override;
end;
{Object created when microscope uses a ESP300 micromanipulator to move the XYZ stage.
Module hardconfig enforces the rule that if ESP300 is used for XY, ESP300 is used for Z.
A TZESP300 and a TXYESP300 objects are instantiated. They all refer to the TXYZESP300 object
(not seen by user)
}
TZESP300 = class(TZStepper)
function GetDeviceState: TDeviceState; override;
procedure SetSpeed(speedIndex: integer); override;
public
procedure Connect; override;
procedure GetZ(var newZ: double); override;
procedure MoveToRelativeZ(newDeltaZ: double); override;
procedure SetZ(var newZ: double); override;
procedure MoveToZ(newZ: double); override;
function ReadZ: double; override;
procedure ShiftByZ(deltaZ: double); override;
function TravelTime(zTravel: integer; speedIndex: integer): double; override;
procedure StartFastScan; override;
procedure StopFastScan; override;
constructor Create;
destructor Destroy; override;
end;
{interfaces with the X-Y-Z Newport XPS controller}
TZ_XPS = class(TZStepper)
function GetDeviceState: TDeviceState; override;
procedure SetSpeed(speedIndex: integer); override;
public
procedure Connect; override;
procedure GetZ(var newZ: double); override;
procedure MoveToRelativeZ(newDeltaZ: double); override;
procedure SetZ(var newZ: double); override;
procedure MoveToZ(newZ: double); override;
function ReadZ: double; override;
procedure ShiftByZ(deltaZ: double); override;
function TravelTime(zTravel: integer; speedIndex: integer): double; override;
procedure StartFastScan; override;
procedure StopFastScan; override;
constructor Create;
destructor Destroy; override;
end;
{Object created when microscope uses a Galil DMC-40x0 controller to move the XYZ stage.
Module hardconfig enforces the rule that if DMC is used for XY, DMC is used for Z.
A T_ZDMC40 and a TXY_DMC40 objects are instantiated. They all refer to the TDMC40 object
(not seen by user)
}
{interfaces with the X-Y-Z Galil DMC controller}
TZ_DMC40 = class(TZStepper)
function GetDeviceState: TDeviceState; override;
public
procedure Connect; override;
procedure GetZ(var newZ: double); override;
procedure MoveToRelativeZ(newDeltaZ: double); override;
procedure SetZ(var newZ: double); override;
procedure MoveToZ(newZ: double); override;
function ReadZ: double; override;
procedure ShiftByZ(deltaZ: double); override;
function TravelTime(zTravel: integer; speedIndex: integer): double; override;
procedure StartFastScan; override;
procedure StopFastScan; override;
constructor Create;
destructor Destroy; override;
end;
{**************************** X-Y Translation table ***************************}
{All moves in microns}
{Any device using a COM port should release it on being destroyed}
TXYTable = class(TMPScanDevice)
private
fBusy: boolean;
pNewX, pNewY: PInteger;
desiredX, desiredY, iterationCount: integer;
function GetCOMPort: integer;
function GetCOMSpeed: integer;
function GetInvertX: boolean;
function GetInvertY: boolean;
function GetSpeed: integer;
procedure SetCOMPort(portIndex: integer);
procedure SetCOMSpeed(portSpeed: integer);
procedure SetInvertX(bInvert: boolean);
procedure SetInvertY(bInvert: boolean);
procedure SetSpeed(value: integer); virtual;
public
fXPosition, fYPosition: integer;
autoObject: IMPXYTable;
reply: string; // 8-6-09 ALS
procedure OnMoveStarted; {updates user interface}
procedure OnMoveFinished;
{asynchronous calls}
procedure GetXY(var newX, newY: integer); virtual;
procedure SetXY(var newX, newY: integer); virtual;
procedure SetRelativeXY(deltaX, deltaY: integer); virtual;
{synchronous calls: return when complete}
procedure MoveToXY(newX, newY: integer); virtual;
procedure ReadXY(var x, y: integer); virtual;
procedure ShiftByXY(deltaX, deltaY: integer); virtual;
procedure
XYCommand(const sCommand: string); virtual;
procedure GalilWaitForMotionComplete; virtual;
property Busy: boolean read fBusy write fBusy;
property InvertX: boolean read GetInvertX write SetInvertX;
property InvertY: boolean read GetInvertY write SetInvertY;
property COMPort: integer read GetCOMPort write SetCOMPort;
property COMSpeed: integer read GetCOMSpeed write SetCOMSpeed;
property Speed: integer read GetSpeed write SetSpeed; {1: slowest, 20: fastest}
property XPosition: integer read fXPosition write fXPosition;
property YPosition: integer read fYPosition write fYPosition;
constructor Create;
destructor Destroy; override;
end;
{Finite state machine for various operations}
TNeatStatus = (neatOK,
neatTERM3,
neatMFE,
neatAA,
neatSE,
neatJE,
neatREAD,
neatREADUPDATE,
neatREADCLOSELOOP,
neatMOVE,
neatMOVECLOSELOOP,
neatCOMMAND,
neatSETSPEED);
TNEAT300 = class(TXYTable)
private
bNoAnswer: boolean;
CaretTriggerHandle, FTriggerHandle, TimerHandle: Word;
neatStatus: TNeatStatus;
serialPort: TApdCOMPort;
s1, s2, s3, sSerial: string; {strings sent back by the serial ports}
procedure TriggerData(CP: TObject; TriggerHandle: Word);
procedure TriggerAvail(CP: TObject; Count: Word);
procedure ParseReturnedString;
procedure TimerReceived(CP: TObject; TriggerHandle: Word);
procedure SetSpeed(value: integer); override;
public
procedure Connect; override;
procedure GetXY(var newX, newY: integer); override;
procedure SetXY(var newX, newY: integer); override;
procedure SetRelativeXY(deltaX, deltaY: integer); override;
procedure MoveToXY(newX, newY: integer); override;
procedure ReadXY(var x, y: integer); override;
procedure ShiftByXY(deltaX, deltaY: integer); override;
procedure XYCommand(const sCommand: string); override;
constructor Create;
destructor Destroy; override;
end;
TXYESP300 = class(TXYTable)
function GetDeviceState: TDeviceState; override;
procedure SetSpeed(value: integer); override;
public
procedure Connect; override;
procedure GetXY(var newX, newY: integer); override;
procedure SetXY(var newX, newY: integer); override;
procedure SetRelativeXY(deltaX, deltaY: integer); override;
procedure MoveToXY(newX, newY: integer); override;
procedure ReadXY(var x, y: integer); override;
procedure ShiftByXY(deltaX, deltaY: integer); override;
procedure XYCommand(const sCommand: string); override;
constructor Create;
destructor Destroy; override;
end;
TXYMP285 = class(TXYTable)
function GetDeviceState: TDeviceState; override;
procedure SetSpeed(value: integer); override;
public
procedure Connect; override;
procedure GetXY(var newX, newY: integer); override;
procedure SetXY(var newX, newY: integer); override;
procedure SetRelativeXY(deltaX, deltaY: integer); override;
procedure MoveToXY(newX, newY: integer); override;
procedure ReadXY(var x, y: integer); override;
procedure ShiftByXY(deltaX, deltaY: integer); override;
procedure XYCommand(const sCommand: string); override;
constructor Create;
destructor Destroy; override;
end;
{interfaces with the X-Y-Z Newport XPS controller}
TXY_XPS = class(TXYTable)
function GetDeviceState: TDeviceState; override;
procedure SetSpeed(value: integer); override;
public
procedure Connect; override;
procedure GetXY(var newX, newY: integer); override;
procedure SetXY(var newX, newY: integer); override;
procedure SetRelativeXY(deltaX, deltaY: integer); override;
procedure MoveToXY(newX, newY: integer); override;
procedure ReadXY(var x, y: integer); override;
procedure ShiftByXY(deltaX, deltaY: integer); override;
procedure XYCommand(const sCommand: string); override;
constructor Create;
destructor Destroy; override;
end;
{hidden object controlling the XPS device}
TXPS = class(TMPScanDevice)
xpsThread: TXPSThread;
procedure SetXYSpeed(speedIndex: integer);
procedure SetZSpeed(speedIndex: integer);
public
procedure Connect; override;
procedure GetZ(var newZ: double);
procedure MoveToRelativeZ(newDeltaZ: double);
procedure SetZ(var newZ: double);
procedure MoveToZ(newZ: double);
function ReadZ: double;
procedure ShiftByZ(deltaZ: double);
procedure GetXY(var newX, newY: integer);
procedure SetXY(var newX, newY: integer);
procedure SetRelativeXY(deltaX, deltaY: integer);
procedure MoveToXY(newX, newY: integer);
procedure ReadXY(var x, y: integer);
procedure ShiftByXY(deltaX, deltaY: integer);
procedure XYCommand(const sCommand: string); {do nothing: XPS DLL does not allow string commands}
procedure FastStackCallback;
procedure StartFastStack(fsSpeed: integer; deltaZ: double);
constructor Create;
destructor Destroy; override;
end;
{************************** Galil DMC-40x controller *************************}
{interfaces with the X-Y-Z Galil DMC controller}
TXY_DMC40 = class(TXYTable)
function GetDeviceState: TDeviceState; override;
public
procedure Connect; override;
procedure GetXY(var newX, newY: integer); override;
procedure SetXY(var newX, newY: integer); override;
procedure SetRelativeXY(deltaX, deltaY: integer); override;
procedure MoveToXY(newX, newY: integer); override;
procedure ReadXY(var x, y: integer); override;
procedure ShiftByXY(deltaX, deltaY: integer); override;
procedure XYCommand(const sCommand: string); override;
procedure GalilWaitForMotionComplete; override;//PB
constructor Create;
destructor Destroy; override;
end;
{hidden object controlling the Galil controller}
TDMC40 = class(TMPScanDevice)
public
GalilThread: TGalilThread;
GalilSemaphore: THandle;
procedure Connect; override;
procedure GetZ(var newZ: double);
procedure MoveToRelativeZ(newDeltaZ: double);
procedure SetZ(var newZ: double);
procedure MoveToZ(newZ: double);
function ReadZ: double;
procedure ShiftByZ(deltaZ: double);
procedure GetXY(var newX, newY: integer);
procedure SetXY(var newX, newY: integer);
procedure SetRelativeXY(deltaX, deltaY: integer);
procedure MoveToXY(newX, newY: integer);
procedure ReadXY(var x, y: integer);
procedure ShiftByXY(deltaX, deltaY: integer);
procedure XYCommand(const sCommand: string);
procedure FastStackCallback;
procedure StartFastStack(fsSpeed: integer; deltaZ: double);
procedure GalilWaitForMotionComplete;
constructor Create;
destructor Destroy; override;
end;
{****************************** Micromanipulators *****************************}
{Operations}
TMManOp = (mmanOK, mmanGetPos, mmanSetSpeed, mmanMove, mmanGetPosAndWait, mmanCommand,
mmanMoveFast, mmanUpdateDisplay, mmanGetResolution);
TMManCoordinates = (mmanX, mmanY, mmanZ);
TMManPt = array[mmanX..mmanZ] of double; {coordinates in microns in micromanipulator}
TXYZPt = TMManPt; {coordinates in microns for the microscope}
TMManPhase = (mpIdle, mpCalibrated, mpTargeted, mpTargeted_Calibrated, mpApproached, mpDescended, mpContacting);
TMicromanipulator = class(TMPScanDevice)
private
fSpeed: integer; {in microns / s}
fmmanPhase: TMManPhase;
fmanindex: integer;
mmanOp: TMManOp;
calibMatrix: array[0..2, 0..2] of double;
fBusy: boolean;
procedure FindDescentPosition(var descentPos: TMManPt);
function GetApproachAngle: double;
function GetApproachSpeed: integer;
function GetAxialIsXZ: boolean;
function GetCalibrationShift: integer;
function GetCoarseMotion: boolean; virtual;
function GetCOMPort: integer;
function GetCOMSpeed: integer;
function GetContactSpeed: integer;
function GetContactStepSize: double;
function GetDescentSpeed: integer;
function GetInvertX: boolean;
function GetInvertY: boolean;
function GetInvertZ: boolean;
function GetFirstMotionType: TMManCoordinates;
function GetmmReadDelay: integer;
function GetSecondMotionType: TMManCoordinates;
function GetThirdMotionType: TMManCoordinates;
function GetstartDescentDistance: double;
function GetstopDescentDistance: double;
function GetxyzReadDelay: integer;
procedure XYZToManipulator(xyzPt: TXYZPt; var manPt: TMManPt);
procedure SetApproachAngle(value: double);
procedure SetApproachSpeed(value: integer);
procedure SetAxialIsXZ(value: boolean);
procedure SetCalibrationShift(value: integer);
procedure SetCoarseMotion(value: boolean); virtual;
procedure SetCOMPort(value: integer);
procedure SetCOMSpeed(value: integer);
procedure SetContactSpeed(value: integer);
procedure SetContactStepSize(value: double);
procedure SetDescentSpeed(value: integer);
procedure SetInvertX(value: boolean);
procedure SetInvertY(value: boolean);
procedure SetInvertZ(value: boolean);
procedure SetFirstMotionType(value: TMManCoordinates);
procedure SetmmReadDelay(value: integer);
procedure SetSecondMotionType(value: TMManCoordinates);
procedure SetSpeed(value: integer); virtual; {in microns/s}
procedure SetThirdMotionType(value: TMManCoordinates);
procedure SetstartDescentDistance(value: double);
procedure SetstopDescentDistance(value: double);
procedure SetxyzReadDelay(value: integer);
public
homePt, currentPos: TMManPt;
mmanCalibrationPts: array[0..3] of TMManPt;
xyzCalibrationPts: array[0..3] of TXYZPt;
xyzTargetPt: TXYZPt;
procedure Calibrate;
procedure ContactMoveDown(bDown: boolean);
procedure GetXYZ; virtual; {in microns}
procedure GetCurrentMMPosition;
procedure GoHome;
procedure GotoDescentPos;
procedure MoveAndWait(manPt: TMManPt);
procedure MoveToXYZ(newX, newY, newZ: double); virtual;
procedure MoveRelative(deltaX, deltaY, deltaZ: double);
procedure StartApproach;
procedure StartDescent;
constructor CreateManip(index: integer);
property approachAngle: double read GetApproachAngle write SetApproachAngle;
property approachSpeed: integer read GetApproachSpeed write SetApproachSpeed;
property axialIsXZ: boolean read GetAxialIsXZ write SetAxialIsXZ;
property calibrationShift: integer read GetCalibrationShift write SetCalibrationShift;
property Busy: boolean read fBusy;
property CoarseMotion: boolean read GetCoarseMotion write SetCoarseMotion;
property COMPort: integer read GetCOMPort write SetCOMPort;
property COMSpeed: integer read GetCOMSpeed write SetCOMSpeed;
property contactSpeed: integer read GetContactSpeed write SetContactSpeed;
property contactStepSize: double read GetContactStepSize write SetContactStepSize;
property descentSpeed: integer read GetDescentSpeed write SetDescentSpeed;
property InvertX: boolean read GetInvertX write SetInvertX;
property InvertY: boolean read GetInvertY write SetInvertY;
property InvertZ: boolean read GetInvertZ write SetInvertZ;
property firstMotionType: TMManCoordinates read GetFirstMotionType write SetFirstMotionType;
property mmReadDelay: integer read GetmmReadDelay write SetmmReadDelay;
property secondMotionType: TMManCoordinates read GetSecondMotionType write SetSecondMotionType;
property thirdMotionType: TMManCoordinates read GetThirdMotionType write SetThirdMotionType;
property Phase: TMManPhase read fMManPhase write fMManPhase;
property Speed: integer read fSpeed write SetSpeed;
property startDescentDistance: double read GetstartDescentDistance write SetstartDescentDistance;
property stopDescentDistance: double read GetstopDescentDistance write SetstopDescentDistance;
property xyzReadDelay: integer read GetxyzReadDelay write SetxyzReadDelay;
end;
TMP285MoveRec = packed record
case integer of
1: (command: Char;
x, y, z: integer);
2: (ss: array[0..12] of Char);
end;
TMP285SpeedRec = packed record
case integer of
1: (command: Char;
speed: int16);
2: (ss: array[0..2] of Char);
end;
TMP285 = class(TMicromanipulator)
private
microstepsPerMicron: double;
CRTriggerHandle, TimerHandle: Word;
serialPort: TApdCOMPort;
sserial: string; {strings sent back by the serial ports}
function GetCoarseMotion: boolean; override;
procedure SetCoarseMotion(value: boolean); override;
procedure SetSpeed(value: integer); override;
procedure TriggerData(CP: TObject; TriggerHandle: Word);
procedure TriggerAvail(CP: TObject; Count: Word);
procedure TimerReceived(CP: TObject; TriggerHandle: Word);
procedure UpdateMP285Display;
public
procedure Connect; override;
procedure GetXYZ; override;
procedure MoveToXYZ(newX, newY, newZ: double); override;
constructor CreateManip(index: integer);
destructor Destroy; override;
end;
{******************************** Laser Control *******************************}
TLaserControl = class(TMPScanDevice)
private
fWavelength : integer;
fPower: double;
function GetincA: double;
function GetincB: double;
function GetincC: double;
function GetincD: double;
function GetdecA: double;
function GetdecB: double;
function GetdecC: double;
function GetdecD: double;
function GetCOMPort: integer;
function GetCOMSpeed: integer;
procedure SetincA(value: double);
procedure SetincB(value: double);
procedure SetincC(value: double);
procedure SetincD(value: double);
procedure SetdecA(value: double);
procedure SetdecB(value: double);
procedure SetdecC(value: double);
procedure SetdecD(value: double);
procedure SetCOMPort(value: integer);
procedure SetCOMSpeed(value: integer);
procedure SetPower(newPower: double); virtual;
procedure SetWavelength(newWavelength: integer); virtual;
public
autoObject: IMPLaserControl;
constructor Create;
destructor Destroy; override;
{pulse width at GPCTR0 = f(LaserPower, A, B, C, D)}
property incA: double read GetincA write SetincA;
property incB: double read GetincB write SetincB;
property incC: double read GetincC write SetincC;
property incD: double read GetincD write SetincD;
property decA: double read GetdecA write SetdecA;
property decB: double read GetdecB write SetdecB;
property decC: double read GetdecC write SetdecC;
property decD: double read GetdecD write SetdecD;
property COMPort: integer read GetCOMPort write SetCOMPort;
property COMSpeed: integer read GetCOMSpeed write SetCOMSpeed;
property Power: double read fPower write SetPower;
property Wavelength: integer read fWavelength write SetWavelength;
end;
TKimZhangLaserControl = class(TLaserControl)
private
prevPower: integer;
procedure SetPower(newPower: double); override;
public
procedure Connect; override;
constructor Create;
end;
{*********************************** Z Piezo **********************************}
TZPiezo = class(TMPScanDevice)
private
fZPiezoRange: double;
public
procedure OnScanningStarts; virtual;
procedure OnScanningEnds; virtual;
function ValidateParams(fromZ, toZ, deltaZ: double): boolean; virtual;
procedure Connect; override;
constructor Create;
property ZPiezoRange: double read fZPiezoRange;
end;
{MIPOS 100 from PiezoJena: 100 microns displacement, 0..10V command}
TMIPOS100 = class(TZPiezo)
private
zPiezoValues: array of int16; {contains digital voltages for the ramp to move the piezo}
public
procedure OnScanningStarts; override; {outputs a ramp}
procedure OnScanningEnds; override; {at the end,put piezo back to original pos}
function ValidateParams(fromZ, toZ, deltaZ: double): boolean; override;
procedure Connect; override;
constructor Create;
end;
{PI PIFOC 725 from PiezoJena: 400 microns displacement, 0..10V command}
TPIFOC725 = class(TMIPOS100)
constructor Create;
end;
{ **************************************************************************** }
{*} {*}
{* GLOBAL DEVICE OBJECTS *}
{*} {*}
{ **************************************************************************** }
const
deviceState: array[dsNotInstalled..dsDetected] of string =
('Not Installed', 'Installed', 'Not Found', 'Detected');
var
multifunctionBoard: TMultifunctionBoard;
analogOutputBoard: TAnalogOutputBoard;
opticsOutputBoard: TOpticsOutputBoard;
photonCountingBoard: TPhotonCountingBoard;
laserShutter: TLaserShutter;
XYTable: TXYTable;
ZStepper: TZStepper;
micromanipulators: array[1..2] of TMicromanipulator;
xydeviceType: HARD_XY_TABLE; {0: not installed; 1: NEAT 300; 2: MP-285; 3: EPS 300; 4: XPS; 5: GALIL}
zStepperDeviceType: HARD_Z_STEPPER; {0: not installed; 1: Earl's; 2: MP-285; 3: EPS 300; 4: XPS; 5: GALIL}
mmDeviceType: array[1..2] of integer;{0: not installed, 1: MP-285, 2: MP-385}
laserControlType: HARD_LASER_CONTROL; {0: not installed; 1: Kim and Zhang; 2: Kim and Zhang Mai_Tai_0; 3: Kim and Zhang Mai_Tai_1}
laserControl: TLaserControl;
zPiezo: TZPiezo;
zPiezoType, {0: not installed; 1: 100 um piezo, 2: 400 um piezo}
zPiezoOutChannel: integer;
XPS_IP, XPS_GroupName: string;
xps: TXPS;
dmc40: TDMC40;
procedure LoadConfigFromRegistry;
procedure LoadDeviceFromConfiguration;
procedure Reconnect;
procedure SaveDeviceConfigurations;
procedure DestroyDevices;
{ **************************************************************************** }
{*} {*}
{*} IMPLEMENTATION {*}
{*} {*}
{ **************************************************************************** }
uses Nidaq, Nidaqcns, Registry, IniFiles, Math, Forms, Dialogs,Mainfrm,
Graphics;
type
TMP285Config = packed record
flags,
udirx,
udiry,
udirz: byte;
roe_vari,
uoffset,
urange,
pulse,
uspeed: word;
indevice,
flags_2: byte; {bit 2(STEP_MODE) = 4; Set = 50 usteps / step, reset: 10 usteps/steps; 1 step = 2 um}
jumpspd,
highspd,
dead,
watch_dog,
step_div,
step_mul,
flip_pt,
flpcalc: word;
end;
{hidden object which TZMP285 and TXYMP285 delegate their call}
TXYZMP285 = class(TMPScanDevice)
microstepsPerMicron: double; {25: 0.04 microns per step; 5: 5 microns per step}
CRTriggerHandle, TimerHandle: Word;
serialPort: TApdCOMPort;
sserial: string; {strings sent back by the serial ports}
mmanOp: TMManOp;
procedure GetResolution; {sets microstepsPerMicron}
procedure TriggerData(CP: TObject; TriggerHandle: Word);
procedure TriggerAvail(CP: TObject; Count: Word);
procedure TimerReceived(CP: TObject; TriggerHandle: Word);
procedure SetSpeed(value: integer);
procedure UpdateMP285Display;
public
procedure Connect; override;
procedure GetXYZ; {synchronous; returns values in zStepper and XYTable}
procedure SetXYZ(newX, newY: integer; newZ: double); {in microns}
procedure SetXYZFast(newX, newY: integer; newZ: double); {in microns}
procedure XYCommand(const sCommand: string);
constructor Create;
destructor Destroy; override;
end;
const
ESP300_XY_LIMIT = 1.0;
ESP300_Z_LIMIT = 0.1;
type
TESPMode = (ESP300_READY, ESP300_READING_X, ESP300_READING_Y,ESP300_READING_Z,
ESP300_MOVING_X, ESP300_MOVING_Y,ESP300_MOVING_Z, ESP300_COMMAND);
{hidden object which TZMP285 and TXYMP285 delegate their call}
TXYZESP300 = class(TMPScanDevice)
CRTriggerHandle, TimerHandle: Word;
serialPort: TApdCOMPort;
sserial: string; {strings sent back by the serial ports}
pX, pY, pZ: double;
lastX, lastY, lastZ,
maxVelocityX, maxVelocityY, maxVelocityZ: double; {in microns}
mmanOp: TMManOp;
fBusy, bMoveDone, bMovingError, bReading: boolean;
fESPMode: TESPMode;
procedure TriggerData(CP: TObject; TriggerHandle: Word);
procedure TriggerAvail(CP: TObject; Count: Word);
procedure TimerReceived(CP: TObject; TriggerHandle: Word);
procedure SetXYSpeed(speedIndex: integer);
procedure SetZSpeed(speedIndex: integer);
public
procedure Connect; override;
procedure GetZ(var newZ: double);
procedure MoveToRelativeZ(newDeltaZ: double);
procedure SetZ(var newZ: double);
procedure MoveToZ(newZ: double);
function ReadZ: double;
procedure ShiftByZ(deltaZ: double);
procedure GetXY(var newX, newY: integer);
procedure SetXY(var newX, newY: integer);
procedure SetRelativeXY(deltaX, deltaY: integer);
procedure MoveToXY(newX, newY: integer);
procedure ReadXY(var x, y: integer);
procedure ShiftByXY(deltaX, deltaY: integer);
procedure XYCommand(const sCommand: string);
constructor Create;
destructor Destroy; override;
end;
{hidden object; XY and Z XPS objects delegate calls to this object}
const
{Registry entries}
sDevices = 'Devices';
smultifunctionBoardIndex = 'multifunctionBoardIndex';
sTTLTriggerLine = 'TTLTriggerLine';
sanalogOutBoardIndex = 'analogOutBoardIndex';
sOpticsOutBoardIndex = 'opticsOutBoardIndex';
sPhotonCountingBoardIndex = 'PhotonCountingBoardIndex';
sbAnalogOutBoardInstalled = 'bAnalogOutBoardInstalled';
sbOpticsControlBoardInstalled = 'bOpticsControlBoardInstalled';
sbPhotonCountingBoardInstalled = 'PhotonCountingBoardInstalled';
sInvertPreamps = 'Invert Preamps';
sbLogicLow = 'bLogicLow';
sPMTOffsets: array[0..MAX_CH - 1] of string = ('PMT Offset 0', 'PMT Offset 1', 'PMT Offset 2', 'PMT Offset 3');
sbAnalogOutBrdControlsShutter = 'bAnalogOutBrdControlsShutter';
smultifuncBoardShutterIndex = 'multifuncBoardShutterIndex';
sbCloseShutterAfterSection = 'bCloseShutterAfterSection';
sshutterDelay = 'shutterDelay';
sxydeviceType = 'xydeviceType';
sxydeviceCOMPortIndex = 'xydeviceCOMPortIndex';
sxydeviceCOMSpeedIndex = 'xydeviceCOMSpeedIndex';
sxydeviceManualSpeed = 'xydeviceManualSpeed';
sbxydeviceInvertX = 'bxydeviceInvertX';
sbxydeviceInvertY = 'bxydeviceInvertY';
szStepperDeviceType = 'zStepperDeviceType';
szStepperCOMPort = 'z Stepper COM Port';
szStepperCOMSpeed = 'z Stepper COM Speed';
szStepperSpeed = 'z Stepper Stepping Speed';
szStepperInvert = 'z Stepper Invert Motion';
smmDeviceType : array[1..2] of string = ('mm1DeviceType', 'mm2DeviceType');
smmCOMPortIndex: array[1..2] of string = ('mm1COMPortIndex', 'mm2COMPortIndex');
smmCOMSpeedIndex: array[1..2] of string = ('mm1COMSpeedIndex', 'mm2COMSpeedIndex');
smmInvertX: array[1..2] of string = ('bmm1InvertX', 'bmm2InvertX');
smmInvertY: array[1..2] of string = ('bmm1InvertY', 'bmm2InvertY');
smmInvertZ: array[1..2] of string = ('bmm1InvertZ', 'bmm2InvertZ');
saxialIsXZs: array[1..2] of string = ('axialIsXZ1', 'axialIsXZ2');
scalibrationShifts : array[1..2] of string = ('calibrationShift1','calibrationShift2');
sapproachAngles : array[1..2] of string = ('approachAngle1','approachAngle2');
sapproachSpeeds : array[1..2] of string = ('approachSpeed1','approachSpeed2');
scontactSpeeds : array[1..2] of string = ('contactSpeed1','contactSpeed2');
scontactStepSize : array[1..2] of string = ('contactStepSize1','contactStepSize2');
sdescentSpeeds : array[1..2] of string = ('descentSpeed1','descentSpeed2');
sstartDescentDistances : array[1..2] of string = ('startDescentDistance1','startDescentDistance2');
sstopDescentDistances : array[1..2] of string = ('stopDescentDistance1','stopDescentDistance2');
sfirstMotionTypes : array[1..2] of string = ('firstMotionType1','firstMotionType2');
ssecondMotionTypes : array[1..2] of string = ('secondMotionType1','secondMotionType2');
sthirdMotionTypes : array[1..2] of string = ('thirdMotionType1','thirdMotionType2');
sT1Array: array[0..1] of string = ('T1_X', 'T1_Y');
sT2Array: array[0..1] of string = ('T2_X', 'T2_Y');
sDeltaTArray: array[0..1] of string = ('DeltaT_X', 'T1_Y');
sLaserControlType = 'Laser Control Type';
sLaserControlincA = 'Laser Control inc A';
sLaserControlincB = 'Laser Control inc B';
sLaserControlincC = 'Laser Control inc C';
sLaserControlincD = 'Laser Control inc D';
sLaserControldecA = 'Laser Control dec A';
sLaserControldecB = 'Laser Control dec B';
sLaserControldecC = 'Laser Control dec C';
sLaserControldecD = 'Laser Control dec D';
sLaserControlCOMPortIndex = 'Laser Control COM Port';
sLaserControlCOMSpeedIndex = 'Laser Control COM Speed';
sAnalogChNames: array[1..2] of string = ('AnalogChName1', 'AnalogChName2');
sAnalogChPrefixes: array[1..2] of string = ('AnalogChPrefix1', 'AnalogChPrefix2');
sAnalogChConvFactors: array[1..2] of string = ('AnalogChConvFactor1', 'AnalogChConvFactor2');
sAnalogChUnits: array[1..2] of string = ('AnalogChUnit1', 'AnalogChUnit2');
sAnalogChZeroOffsets: array[1..2] of string = ('AnalogChZeroOffset1', 'AnalogChZeroOffset2');
sxyzReadDelay = 'xyzReadDelay';
smmReadDelay = 'mmReadDelay';
sZPiezoType = 'Z Piezo Type';
sZPiezoOutChannel = 'Z Piezo output channel';
sXPS_IP = 'XPS IP address';
sXPS_GroupName = 'XPS group name';
MAX_CLOSE_LOOP_ITERATIONS = 20; {for NEAT300 close loop positioning}
MICROSTEP_SIZE = 25; {for MP-285}
var
multifunctionBoardIndex,
analogOutBoardIndex,
opticsOutBoardIndex,
PhotonCountingBoardIndex,
TTLTriggerLine: integer;
bAnalogOutBoardInstalled,
bOpticsOutputBoardInstalled,
bPhotonCountingBoardInstalled,
bLogicLow: boolean;
PMTOffsetArray: array[0..MAX_CH - 1] of int16;
T1Array, T2Array, DeltaTArray: array[0..1] of integer; {feedforward mirror parameters}
bAnalogOutBrdControlsShutter: boolean;
multifuncBoardShutterIndex: integer;
bCloseShutterAfterSection: boolean;
shutterDelay: integer; {in ms}
invertPreamps: boolean; {12-11-07}
xydeviceCOMPortIndex,
xydeviceCOMSpeedIndex,
xydeviceManualSpeed: integer; {1 to 10}
bxydeviceInvertX,
bxydeviceInvertY: boolean;
zStepperCOMPort, {for future steppers using a COM port}
zStepperCOMSpeed,
zStepperSpeed: integer;
zStepperInvert: boolean;
xyzMP285: TXYZMP285;
xyzESP300: TXYZESP300;
fxyzReadDelay, fmmReadDelay: integer; {delays to read MP-285 after move}
bmmInvertX, bmmInvertY, bmmInvertZ: array[1..2] of boolean;
mmCOMPortIndex,
mmCOMSpeedIndex: array[1..2] of integer;
calibrationShifts: array[1..2] of integer;
approachSpeeds,
contactSpeeds,
descentSpeeds: array[1..2] of integer;
approachAngles,
contactStepSizes,
startDescentDistances,
stopDescentDistances: array[1..2] of double;
firstMotionTypes,
secondMotionTypes,
thirdMotionTypes: array[1..2] of TMManCoordinates;
axialIsXZs: array[1..2] of boolean;
laserControlincA, laserControlincB, laserControlincC, laserControlincD,
laserControldecA, laserControldecB, laserControldecC, laserControldecD: double;
laserControlCOMPortIndex,
laserControlCOMSpeedIndex: integer;
fAnalogChConvFactors: array[1..2] of double;
fAnalogChNames: array[1..2] of string;
fAnalogChPrefixes: array[1..2] of TPrefix;
fAnalogChUnits: array[1..2] of string;
fAnalogChZeroOffsets: array[1..2] of double;
outputChannels: array[0..3] of int16;
function FindDistance(pt1, pt2: TMManPt): double;
begin
Result := Sqrt(Sqr(pt1[mmanX] - pt2[mmanY]) + Sqr(pt1[mmanY] - pt2[mmanY])
+ Sqr(pt1[mmanZ] - pt2[mmanZ]));
end;
procedure DestroyDevices;
begin
FreeAndNil(multifunctionBoard);
FreeAndNil(analogOutputBoard);
FreeAndNil(opticsOutputBoard);
FreeAndNil(laserShutter);
FreeAndNil(XYTable);
FreeAndNil(ZStepper);
FreeAndNil(micromanipulators[1]);
FreeAndNil(micromanipulators[2]);
FreeAndNil(laserControl);
FreeAndNil(zPiezo);
end;
procedure Reconnect;
begin
DestroyDevices;
{creates objects and sets properties}
multifunctionBoard := TMultifunctionBoard.Create;
analogOutputBoard := TAnalogOutputBoard.Create;
opticsOutputBoard := TOpticsOutputBoard.Create;
laserShutter := TLaserShutter.Create;
case xydeviceType of
XY_NEAT300: XYTable := TNEAT300.Create;
XY_MP285: XYTable := TXYMP285.Create;
XY_ESP300: XYTable := TXYESP300.Create;
XY_XPS: XYTable := TXY_XPS.Create;
XY_GALIL: XYTable := TXY_DMC40.Create;
else XYTable := TXYTable.Create;
end;
XYTable.Connect;
case zStepperDeviceType of
Z_EARL: zStepper := TEarlStepper.Create;
Z_MP285: zStepper := TZMP285.Create;
Z_ESP300: zStepper := TZESP300.Create;
Z_XPS: zStepper := TZ_XPS.Create;
Z_GALIL: zStepper := TZ_DMC40.Create;
else zStepper := TzStepper.Create;
end;
ZStepper.Connect;
case mmDeviceType[1] of
0: micromanipulators[1] := TMicromanipulator.CreateManip(1);
else micromanipulators[1] := TMP285.CreateManip(1);
end;
micromanipulators[1].Connect;
case mmDeviceType[2] of
0: micromanipulators[2] := TMicromanipulator.CreateManip(2);
else micromanipulators[2] := TMP285.CreateManip(2);
end;
micromanipulators[2].Connect;
case laserControlType of
LASER_NOT_INSTALLED: laserControl := TLaserControl.Create;
else laserControl := TKimZhangLaserControl.Create;
end;
laserControl.Connect;
case zPiezoType of
ZPIEZO_NONE: zPiezo := TZPiezo.Create;
ZPIEZO_MIPOS100: zPiezo := TMIPOS100.Create {ZPIEZO_MIPOS100};
else zPiezo := TPIFOC725.Create;
end;
zPiezo.Connect;
end;
procedure LoadConfigFromRegistry;
var i: integer;
begin
with TRegistryIniFile.Create(sAppName) do
begin
multifunctionBoardIndex := ReadInteger(sDevices, smultifunctionBoardIndex, DEFAULT_DEVICE_INDEX);
analogOutBoardIndex := ReadInteger(sDevices, sanalogOutBoardIndex, DEFAULT_SHUTTER_DEVICE_INDEX);
opticsOutBoardIndex := ReadInteger(sDevices, sOpticsOutBoardIndex, DEFAULT_OPTICS_DEVICE_INDEX);
PhotonCountingBoardIndex := ReadInteger(sDevices, sPhotonCountingBoardIndex, DEFAULT_PHOTON_COUNTING_DEVICE_INDEX);
TTLTriggerLine := ReadInteger(sDevices, sTTLTriggerLine, 0);
bAnalogOutBoardInstalled := ReadBool(sDevices, sbAnalogOutBoardInstalled, True);
bOpticsOutputBoardInstalled := ReadBool(sDevices, sbOpticsControlBoardInstalled, False);
bPhotonCountingBoardInstalled := ReadBool(sDevices, sbPhotonCountingBoardInstalled, False);
InvertPreamps := ReadBool(sDevices, sInvertPreamps, False);
bLogicLow := ReadBool(sDevices, sbLogicLow, True);
bAnalogOutBrdControlsShutter := ReadBool(sDevices, sbAnalogOutBrdControlsShutter, True);
PMTOffsetArray[0] := int16(ReadInteger(sDevices, sPMTOffsets[0], 0));
PMTOffsetArray[1] := int16(ReadInteger(sDevices, sPMTOffsets[1], 0));
PMTOffsetArray[2] := int16(ReadInteger(sDevices, sPMTOffsets[2], 0));
PMTOffsetArray[3] := int16(ReadInteger(sDevices, sPMTOffsets[3], 0));
multifuncBoardShutterIndex := ReadInteger(sDevices, smultifuncBoardShutterIndex, 0);
bCloseShutterAfterSection := ReadBool(sDevices, sbCloseShutterAfterSection, True);
shutterDelay := ReadInteger(sDevices, sshutterDelay, 100); {100 ms}
xydeviceType := HARD_XY_TABLE(ReadInteger(sDevices, sxydeviceType, Ord(XY_NOT_INSTALLED))); {Not installed}
xydeviceCOMPortIndex := ReadInteger(sDevices, sxydeviceCOMPortIndex, 1);
xydeviceCOMSpeedIndex := ReadInteger(sDevices, sxydeviceCOMSpeedIndex, 9600);
bxydeviceInvertX := ReadBool(sDevices, sbxydeviceInvertX, True);
bxydeviceInvertY := ReadBool(sDevices, sbxydeviceInvertY, True);
xydeviceManualSpeed := ReadInteger(sDevices, sxydeviceManualSpeed, 2);
zStepperDeviceType := HARD_Z_STEPPER(ReadInteger(sDevices, szStepperDeviceType, Ord(Z_NOT_INSTALLED)));
zStepperCOMPort := ReadInteger(sDevices, szStepperCOMPort, 1);
zStepperCOMSpeed := ReadInteger(sDevices, szStepperCOMSpeed, 9600);
zStepperSpeed := ReadInteger(sDevices, szStepperSpeed, 1);
if zStepperSpeed < 1 then zStepperSpeed := 1;
if zStepperSpeed > 20 then zStepperSpeed := 20;
zStepperInvert := ReadBool(sDevices, szStepperInvert, False);
fxyzReadDelay := ReadInteger(sDevices, sxyzReadDelay, 2000);
fmmReadDelay := ReadInteger(sDevices, smmReadDelay, 2000);
for i := 1 to 2 do
begin
mmDeviceType[i] := ReadInteger(sDevices, smmDeviceType[i], 0);
mmCOMPortIndex[i] := ReadInteger(sDevices, smmCOMPortIndex[i], 1);
mmCOMSpeedIndex[i] := ReadInteger(sDevices, smmCOMSpeedIndex[i], 9600);
bmmInvertX[i] := ReadBool(sDevices, smmInvertX[i], False);
bmmInvertY[i] := ReadBool(sDevices, smmInvertY[i], False);
bmmInvertZ[i] := ReadBool(sDevices, smmInvertZ[i], False);
axialIsXZs[i] := ReadBool(sDevices, saxialIsXZs[i], False);
calibrationShifts[i] := ReadInteger(sDevices, scalibrationShifts[i], 100); {100 microns}
approachAngles[i] := ReadFloat(sDevices, sapproachAngles[i], 30); {30 degrees}
{try..finally for compatibility with prev versions of MPScan where speeds were floats}
try
approachSpeeds[i] := ReadInteger(sDevices, sapproachSpeeds[i], 1000); {1000 microns/s}
except
approachSpeeds[i] := Round(ReadFloat(sDevices, sapproachSpeeds[i], 1000)); {1000 microns/s}
end;
try
contactSpeeds[i] := ReadInteger(sDevices, scontactSpeeds[i], 1); {1 micron/s}
except
contactSpeeds[i] := Round(ReadFloat(sDevices, scontactSpeeds[i], 1)); {1 micron/s}
end;
try
descentSpeeds[i] := ReadInteger(sDevices, sdescentSpeeds[i], 10); {10 microns/s}
except
descentSpeeds[i] := Round(ReadFloat(sDevices, sdescentSpeeds[i], 10)); {10 microns/s}
end;
contactStepSizes[i] := ReadFloat(sDevices, scontactStepSize[i], 0.1); {0.1 micron}
startDescentDistances[i] := ReadFloat(sDevices, sstartDescentDistances[i], 200);
stopDescentDistances[i] := ReadFloat(sDevices, sstopDescentDistances[i], 5);
firstMotionTypes[i] := TMManCoordinates(ReadInteger(sDevices, sfirstMotionTypes[i], Ord(mmanZ)));
secondMotionTypes[i] := TMManCoordinates(ReadInteger(sDevices, ssecondMotionTypes[i], Ord(mmanY)));
thirdMotionTypes[i] := TMManCoordinates(ReadInteger(sDevices, sthirdMotionTypes[i], Ord(mmanX)));
{Analog outputs}
fAnalogChConvFactors[i] := ReadFloat(sDevices, sAnalogChConvFactors[i], 1);
fAnalogChNames[i] := ReadString(sDevices, sAnalogChNames[i], 'AO' + IntToStr(i-1));
fAnalogChPrefixes[i] := TPrefix(ReadInteger(sDevices, sAnalogChPrefixes[i], Ord(tpUNITY)));
fAnalogChUnits[i] := ReadString(sDevices, sAnalogChUnits[i], 'V');
fAnalogChZeroOffsets[i] := ReadFloat(sDevices, sAnalogChZeroOffsets[i], 0);
end;
for i := 0 to 1 do
begin
T1Array[i] := ReadInteger(sDevices, sT1Array[i], 0);
T2Array[i] := ReadInteger(sDevices, sT2Array[i], 0);
DeltaTArray[i] := ReadInteger(sDevices, sDeltaTArray[i], 0);
end;
laserControlType := HARD_LASER_CONTROL(ReadInteger(sDevices, sLaserControlType, 0));
laserControlincA := ReadFloat(sDevices, sLaserControlincA, -0.5012);
laserControlincB := ReadFloat(sDevices, sLaserControlincB, 2.5569);
laserControlincC := ReadFloat(sDevices, sLaserControlincC, -2.6496);
laserControlincD := ReadFloat(sDevices, sLaserControlincD, 0.49916);
laserControldecA := ReadFloat(sDevices, sLaserControldecA, -0.50032);
laserControldecB := ReadFloat(sDevices, sLaserControldecB, 2.5467);
laserControldecC := ReadFloat(sDevices, sLaserControldecC, -2.582);
laserControldecD := ReadFloat(sDevices, sLaserControldecD, 0.49915);
laserControlComPortIndex := ReadInteger(sDevices, sLaserControlCOMPortIndex, 1);
laserControlComSpeedIndex := ReadInteger(sDevices, sLaserControlCOMSpeedIndex, 9600);
zPiezoType := ReadInteger(sDevices, sZPiezoType, ZPIEZO_NONE);
zPiezoOutChannel := ReadInteger(sDevices, sZPiezoOutChannel, 0);
XPS_IP := ReadString(sDevices, sXPS_IP, '192.168.0.50');
XPS_GroupName := ReadString(sDevices, sXPS_GroupName, 'sample_stage');
Free;
end;
end;
procedure SaveDeviceConfigurations;
var i: integer;
begin
with TRegistryIniFile.Create(sAppName) do
begin
WriteInteger(sDevices, smultifunctionBoardIndex, multifunctionBoardIndex);
WriteInteger(sDevices, sanalogOutBoardIndex, analogOutBoardIndex);
WriteInteger(sDevices, sOpticsOutBoardIndex, opticsOutBoardIndex);
WriteInteger(sDevices, sPhotonCountingBoardIndex, PhotonCountingBoardIndex);
WriteInteger(sDevices, sTTLTriggerLine, TTLTriggerLine);
WriteBool(sDevices, sbAnalogOutBoardInstalled, bAnalogOutBoardInstalled);
WriteBool(sDevices, sbOpticsControlBoardInstalled, bOpticsOutputBoardInstalled);
WriteBool(sDevices, sbPhotonCountingBoardInstalled, bPhotonCountingBoardInstalled);
WriteBool(sDevices, sbLogicLow, bLogicLow);
WriteBool(sDevices, sInvertPreamps, InvertPreamps);
WriteInteger(sDevices, sPMTOffsets[0], PMTOffsetArray[0]);
WriteInteger(sDevices, sPMTOffsets[1], PMTOffsetArray[1]);
WriteInteger(sDevices, sPMTOffsets[2], PMTOffsetArray[2]);
WriteInteger(sDevices, sPMTOffsets[3], PMTOffsetArray[3]);
WriteBool(sDevices, sbAnalogOutBrdControlsShutter, bAnalogOutBrdControlsShutter);
WriteInteger(sDevices, smultifuncBoardShutterIndex, multifuncBoardShutterIndex);
WriteBool(sDevices, sbCloseShutterAfterSection, bCloseShutterAfterSection);
WriteInteger(sDevices, sshutterDelay, shutterDelay);
WriteInteger(sDevices, sxydeviceType, Integer(xydeviceType)); {NEAT 300}
WriteInteger(sDevices, sxydeviceCOMPortIndex, xydeviceCOMPortIndex);
WriteInteger(sDevices, sxydeviceCOMSpeedIndex, xydeviceCOMSpeedIndex);
WriteBool(sDevices, sbxydeviceInvertX, bxydeviceInvertX);
WriteBool(sDevices, sbxydeviceInvertY, bxydeviceInvertY);
WriteInteger(sDevices, sxydeviceManualSpeed, xydeviceManualSpeed);
WriteInteger(sDevices, szStepperDeviceType, Integer(zStepperDeviceType));
WriteInteger(sDevices, szStepperCOMPort, zStepperCOMPort);
WriteInteger(sDevices, szStepperCOMSpeed, zStepperCOMSpeed);
WriteInteger(sDevices, szStepperSpeed, zStepperSpeed);
WriteBool(sDevices, szStepperInvert, zStepperInvert);
WriteInteger(sDevices, sxyzReadDelay, fxyzReadDelay);
WriteInteger(sDevices, smmReadDelay, fmmReadDelay);
for i := 1 to 2 do
begin
WriteInteger(sDevices, smmDeviceType[i], mmDeviceType[i]);
WriteInteger(sDevices, smmCOMPortIndex[i], mmCOMPortIndex[i]);
WriteInteger(sDevices, smmCOMSpeedIndex[i], mmCOMSpeedIndex[i]);
WriteBool(sDevices, smmInvertX[i], bmmInvertX[i]);
WriteBool(sDevices, smmInvertY[i], bmmInvertY[i]);
WriteBool(sDevices, smmInvertZ[i], bmmInvertZ[i]);
WriteInteger(sDevices, scalibrationShifts[i], calibrationShifts[i]);
WriteFloat(sDevices, sapproachAngles[i], approachAngles[i]);
WriteInteger(sDevices, sapproachSpeeds[i], approachSpeeds[i]);
WriteInteger(sDevices, scontactSpeeds[i], contactSpeeds[i]);
WriteFloat(sDevices, scontactStepSize[i], contactStepSizes[i]);
WriteInteger(sDevices, sdescentSpeeds[i], descentSpeeds[i]);
WriteFloat(sDevices, sstartDescentDistances[i], startDescentDistances[i]);
WriteFloat(sDevices, sstopDescentDistances[i], stopDescentDistances[i]);
WriteInteger(sDevices, sfirstMotionTypes[i], Ord(firstMotionTypes[i]));
WriteInteger(sDevices, ssecondMotionTypes[i], Ord(secondMotionTypes[i]));
WriteInteger(sDevices, sthirdMotionTypes[i], Ord(thirdMotionTypes[i]));
WriteBool(sDevices, saxialIsXZs[i], axialIsXZs[i]);
{Analog outputs}
WriteFloat(sDevices, sAnalogChConvFactors[i], fAnalogChConvFactors[i]);
WriteString(sDevices, sAnalogChNames[i], fAnalogChNames[i]);
WriteInteger(sDevices, sAnalogChPrefixes[i], Ord(fAnalogChPrefixes[i]));
WriteString(sDevices, sAnalogChUnits[i], fAnalogChUnits[i]);
WriteFloat(sDevices, sAnalogChZeroOffsets[i], fAnalogChZeroOffsets[i]);
end;
for i := 0 to 1 do
begin
WriteInteger(sDevices, sT1Array[i], T1Array[i]);
WriteInteger(sDevices, sT2Array[i], T2Array[i]);
WriteInteger(sDevices, sDeltaTArray[i], DeltaTArray[i]);
end;
WriteInteger(sDevices, sLaserControlType, Ord(laserControlType));
WriteFloat(sDevices, sLaserControlincA, laserControlincA);
WriteFloat(sDevices, sLaserControlincB, laserControlincB);
WriteFloat(sDevices, sLaserControlincC, laserControlincC);
WriteFloat(sDevices, sLaserControlincD, laserControlincD);
WriteFloat(sDevices, sLaserControldecA, laserControldecA);
WriteFloat(sDevices, sLaserControldecB, laserControldecB);
WriteFloat(sDevices, sLaserControldecC, laserControldecC);
WriteFloat(sDevices, sLaserControldecD, laserControldecD);
WriteInteger(sDevices, sLaserControlCOMPortIndex, laserControlComPortIndex);
WriteInteger(sDevices, sLaserControlCOMSpeedIndex, laserControlComSpeedIndex);
WriteInteger(sDevices, sZPiezoType, zPiezoType);
WriteInteger(sDevices, sZPiezoOutChannel, zPiezoOutChannel);
WriteString(sDevices, sXPS_IP, XPS_IP);
WriteString(sDevices, sXPS_GroupName, XPS_GroupName);
Free;
end;
end;
procedure LoadDeviceFromConfiguration;
begin
{Loads registry values}
LoadConfigFromRegistry;
{creates objects and sets properties}
multifunctionBoard := TMultifunctionBoard.Create;
analogOutputBoard := TAnalogOutputBoard.Create;
opticsOutputBoard := TOpticsOutputBoard.Create;
photonCountingBoard := TPhotonCountingBoard.Create;
laserShutter := TLaserShutter.Create;
case xydeviceType of
XY_NEAT300: XYTable := TNEAT300.Create;
XY_MP285: XYTable := TXYMP285.Create;
XY_ESP300: XYTable := TXYESP300.Create;
XY_XPS: XYTable := TXY_XPS.Create;
XY_Galil: XYTable := TXY_DMC40.Create;
else XYTable := TXYTable.Create;
end;
case zStepperDeviceType of
Z_EARL: zStepper := TEarlStepper.Create;
Z_MP285: zStepper := TZMP285.Create;
Z_ESP300: zStepper := TZESP300.Create;
Z_XPS: zStepper := TZ_XPS.Create;
Z_Galil: zStepper := TZ_DMC40.Create;
else zStepper := TzStepper.Create;
end;
case mmDeviceType[1] of
0: micromanipulators[1] := TMicromanipulator.CreateManip(1);
else micromanipulators[1] := TMP285.CreateManip(1);
end;
case mmDeviceType[2] of
0: micromanipulators[2] := TMicromanipulator.CreateManip(2);
else micromanipulators[2] := TMP285.CreateManip(2);
end;
case laserControlType of
LASER_NOT_INSTALLED: laserControl := TLaserControl.Create;
else laserControl := TKimZhangLaserControl.Create;
end;
case zPiezoType of
ZPIEZO_NONE: zPiezo := TZPiezo.Create;
ZPIEZO_MIPOS100: zPiezo := TMIPOS100.Create {ZPIEZO_MIPOS100};
else zPiezo := TPIFOC725.Create;
end;
end;
function TMPScanDevice.GetDeviceState: TDeviceState;
begin
Result := fDeviceState;
end;
procedure TMPScanDevice.Connect;
begin
fDeviceState := dsNotInstalled;
end;
{********************************* TXYZMP285 ***********************************}
//
// Resolution of MP-285 is 5 microsteps /microns => 0.2 um / step by default
//
procedure TXYZMP285.GetResolution;
var MP285Config: TMP285Config;
begin
mmanOp := mmanGetResolution;
sserial := '';
serialPort.SetTimerTrigger(TimerHandle, 256, True);
{06-23-06; Sutter MP-285 serial port leaves garbage; this cleans it}
PurgeComm(serialPort.Dispatcher.Handle, PURGE_RXCLEAR);
serialPort.PutString('s' + Chr(13));
repeat
Application.ProcessMessages;
until mmanOp = mmanOK;
Move(sserial[1], MP285Config, SizeOf(MP285Config));
if MP285Config.step_div > 32767 then {high-order bit of step_div is set}
microstepsPerMicron := 25
else
microstepsPerMicron := 5;
end;
procedure TXYZMP285.TriggerData(CP: TObject; TriggerHandle: Word);
var newPos: array[0..2] of integer;
i: integer;
begin
serialPort.SetTimerTrigger(TimerHandle, 256, False);
if TriggerHandle <> CRTriggerHandle then Exit;
if mmanOp = mmanOK then Exit; {because TriggerData is called for the last CR}
case mmanOp of
mmanGetPos, mmanGetPosAndWait:
begin
if Length(sserial) >= SizeOf(newPos) then
begin
{copy return string}
Move(sserial[1], newPos, SizeOf(newPos));
{convert microsteps into microns} //
// X, Y are integers , while Z is settled as continuous one
xyTable.fXPosition := Round(newPos[0] / MICROSTEP_SIZE);
xyTable.fYPosition := Round(newPos[1] / MICROSTEP_SIZE);
zStepper.fZPosition := newPos[2] / MICROSTEP_SIZE;
end;
if mmanOp = mmanGetPos then
begin
Mainform.UpdateXYCaptions;
Mainform.UpdateZCaptions;
end;
end;
{mmanSetSpeed: no need to process: there is no acknowledgment}
mmanMove:
begin
{MP-285 is a slow device - this loop adds a delay after a move}
for i := 1 to fxyzReadDelay do Application.ProcessMessages;
xyTable.OnMoveFinished; {updates the captions}
zStepper.OnMoveFinished;
end;
end;
xyTable.fBusy := False;
if zStepper <> nil then zStepper.fBusy := False;
sSerial := '';
mmanOp := mmanOK;
end;
procedure TXYZMP285.TriggerAvail(CP: TObject; Count: Word);
var i: Word;
begin
for i := 1 to Count do
sserial := sserial + serialPort.GetChar;
end;
procedure TXYZMP285.TimerReceived(CP: TObject; TriggerHandle: Word);
begin
if TriggerHandle = TimerHandle then
begin
{time-out: we lost the device}
fDeviceState := dsNotFound;
xyTable.fBusy := False;
if zStepper <> nil then zStepper.fBusy := False;
mmanOp := mmanOK;
end;
end;
procedure TXYZMP285.SetSpeed(value: integer); {1: slowest, 20: fastest}
var s: string;
speedRecord : TMP285SpeedRec;
begin
if mmanOp <> mmanOK then Exit;
speedRecord.command := 'v';
{always low resolution: speed limited to 2900 microns/s}
speedRecord.speed := Muldiv(2900, value, 20);
SetLength(s, SizeOf(TMP285SpeedRec));
Move(speedRecord, s[1], SizeOf(TMP285SpeedRec));
mmanOp := mmanSetSpeed;
sserial := '';
serialPort.SetTimerTrigger(TimerHandle, 256, True);
{06-23-06; Sutter MP-285 serial port leaves garbage; this cleans it}
PurgeComm(serialPort.Dispatcher.Handle, PURGE_RXCLEAR);
serialPort.PutString(s + Chr(13));
repeat
Application.ProcessMessages;
until mmanOp = mmanOK;
end;
procedure TXYZMP285.UpdateMP285Display;
begin
mmanOp := mmanUpdateDisplay;
sserial := '';
serialPort.SetTimerTrigger(TimerHandle, 256, True);
serialPort.PutString('n' + Chr(13));
repeat
Application.ProcessMessages;
until mmanOp = mmanOK;
end;
procedure TXYZMP285.Connect;
begin
if deviceStatus = dsDetected then Exit;
inherited Connect;
try
with serialPort do
begin
Baud := XYTable.COMSpeed;
COMNumber := XYTable.COMPort;
Parity := pNone;
DataBits := 8;
StopBits := 1;
serialPort.Open := True;
CRTriggerHandle := AddDataTrigger(Chr(13), False);
TimerHandle := AddTimerTrigger;
OnTriggerData := TriggerData;
OnTriggerAvail := TriggerAvail;
OnTriggerTimer := TimerReceived;
end;
mmanOp := mmanOK;
try
fDeviceState := dsDetected;
{ GetResolution; DEBUG}
except
fDeviceState := dsNotFound;
end;
except
fDeviceState := dsNotFound;
end;
mmanOp := mmanOK;
end;
procedure TXYZMP285.GetXYZ;
begin
if mmanOp <> mmanOK then Exit;
sserial := '';
mmanOp := mmanGetPosAndWait;
serialPort.SetTimerTrigger(TimerHandle, 256, True);
{06-23-06; Sutter MP-285 serial port leaves garbage; this cleans it}
PurgeComm(serialPort.Dispatcher.Handle, PURGE_RXCLEAR);
serialPort.PutString('c' + Chr(13));
repeat
Application.ProcessMessages;
until mmanOp <> mmanGetPosAndWait;
end;
procedure TXYZMP285.SetXYZ(newX, newY: integer; newZ: double);
var moverecord: TMP285MoveRec;
s: string;
begin
if mmanOp <> mmanOK then Exit;
{converts microns to microsteps}
with moverecord do
begin
command := 'm';
x := newX * MICROSTEP_SIZE; {one microstep = 0.2 microns or 0.04}
y := newY * MICROSTEP_SIZE;
z := Round(newZ * MICROSTEP_SIZE);
end;
SetLength(s, SizeOf(TMP285MoveRec));
Move(moverecord, s[1], SizeOf(TMP285MoveRec));
sserial := '';
mmanOp := mmanMove;
serialPort.SetTimerTrigger(TimerHandle, 256, True);
serialPort.PutString(s + Chr(13)); {go for it}
end;
procedure TXYZMP285.SetXYZFast(newX, newY: integer; newZ: double);
var moverecord: TMP285MoveRec;
s: string;
begin
if mmanOp <> mmanOK then Exit;
{converts microns to microsteps}
with moverecord do
begin
command := 'm';
x := newX * MICROSTEP_SIZE; {one microstep = 0.2 microns}
y := newY * MICROSTEP_SIZE;
z := Round(newZ * MICROSTEP_SIZE);
end;
SetLength(s, SizeOf(TMP285MoveRec));
Move(moverecord, s[1], SizeOf(TMP285MoveRec));
sserial := '';
mmanOp := mmanMoveFast; {no callback}
serialPort.SetTimerTrigger(TimerHandle, 256, True);
serialPort.PutString(s + Chr(13)); {go for it}
end;
procedure TXYZMP285.XYCommand(const sCommand: string);
begin
if mmanOp <> mmanOK then Exit;
sserial := '';
mmanOp := mmanCommand;
serialPort.SetTimerTrigger(TimerHandle, 256, True);
{06-23-06; Sutter MP-285 serial port leaves garbage; this cleans it}
PurgeComm(serialPort.Dispatcher.Handle, PURGE_RXCLEAR);
serialPort.PutString(sCommand + Chr(13)); {go for it}
repeat
Application.ProcessMessages;
until mmanOp = mmanOK;
end;
constructor TXYZMP285.Create;
begin
inherited Create;
microstepsPerMicron := 5;
serialPort := TApdCOMPort.Create(nil);
serialPort.AutoOpen := False;
end;
destructor TXYZMP285.Destroy;
begin
serialPort.Free;
inherited Destroy;
end;
{******************************* NI-DAQ Board *********************************}
{procedure TNIDAQBoard.SetDeviceState(newState: TDeviceState); override;
begin
if newState <> dsNotInstalled then Connect else fDeviceState := newState;
end;}
function TNIDAQBoard.GetBoardIndex: integer;
begin
Result := 0;
end;
procedure TNIDAQBoard.SetBoardIndex(newIndex: integer);
begin
end;
procedure TNIDAQBoard.SetDigitalPort(dioValue: integer);
begin
if fDeviceState = dsDetected then
begin
if fbLogicLow then dioValue := not dioValue;
DIG_Out_Prt(BoardIndex, PORT_0, dioValue);
end;
fDigitalPort := dioValue;
end;
procedure TNIDAQBoard.SetDigitalBit(bitIndex: integer; value: boolean); {takes into account logic}
var mask: integer;
ivalue: Smallint;
begin
mask := 1 shl bitIndex;
if value then
fDigitalPort := fDigitalPort or mask
else
fDigitalPort := fDigitalPort and (not mask);
if fbLogicLow then value := not value;
if value then ivalue := 1 else ivalue := 0;
DIG_Out_Line(BoardIndex, PORT_0, bitIndex, ivalue);
end;
{**************************** TMultifunctionBoard *****************************}
function TMultifunctionBoard.GetInvertPreamps: boolean;
begin
Result := InvertPreamps;
end;
function TMultifunctionBoard.GetBoardIndex: integer;
begin
Result := multifunctionBoardIndex;
end;
function TMultifunctionBoard.GetLogicLow: boolean;
begin
Result := bLogicLow;
end;
{returns the resolution of the analog out channels}
function TMultifunctionBoard.GetMaxAnalogOutDigitalValue: integer;
begin
if (name = sPCI_6110E) then Result := 32768 else Result := 2048;
end;
function TMultifunctionBoard.GetPMTOffsets(chIndex: integer): int16;
begin
if (chIndex >= 0) and (chIndex <= 3) then
Result := PMTOffsetArray[chIndex]
else
Result := 0;
end;
function TMultifunctionBoard.GetTriggerLine: integer;
begin
case TTLTriggerPFILine of
0: Result := ND_PFI_0;
1: Result := ND_PFI_1;
2: Result := ND_PFI_2;
3: Result := ND_PFI_3;
4: Result := ND_PFI_4;
5: Result := ND_PFI_5;
6: Result := ND_PFI_6;
7: Result := ND_PFI_7;
8: Result := ND_PFI_8;
9: Result := ND_PFI_9;
else
Result := ND_PFI_0;
end;
end;
function TMultifunctionBoard.GetTTLTriggerPFILine: integer;
begin
Result := TTLTriggerLine;
end;
procedure TMultifunctionBoard.SetInvertPreamps(value: boolean);
begin
InvertPreamps := value;
end;
procedure TMultifunctionBoard.SetLogicLow(value: boolean);
begin
bLogicLow := value;
end;
procedure TMultifunctionBoard.SetTTLTriggerPFILine(lineIndex: integer);
begin
TTLTriggerLine := lineIndex;
end;
procedure TMultifunctionBoard.SetPMTOffsets(chIndex: integer; value: int16);
begin
PMTOffsetArray[chIndex] := value;
end;
procedure TMultifunctionBoard.Connect;
var dummy: array[0..1] of int16;
begin
if Init_DA_Brds(BoardIndex, @deviceCode) <> 0 then
fDeviceState := dsNotInstalled
else if (deviceCode = PCI_6110E) or (deviceCode = PCI_6115E) or (deviceCode = PXI_6115E) then
begin
if deviceCode = PCI_6115E then name := sPCI_6115E;
if deviceCode = PXI_6115E then name := sPXI_6115E;
fDeviceState := dsDetected;
dummy[0] := 0; dummy[1] := 1;
{------------------------ Configure Digital out ------------------------}
DIG_Prt_Config(BoardIndex, PORT_0, NO_HANDSHAKING, DIGITAL_OUTPUT);
{------------------------ Configure Analog in ------------------------}
Timeout_Config (BoardIndex, INFINITE_TIMEOUT {2 = Maximal timeout allowed <> INFINITE_TIMEOUT});
AI_Configure (BoardIndex, ALL_CHANNELS, DIFFENTIAL, 10, BIPOLAR, driveAIS);
{------------------------ Configure Analog out ------------------------}
AO_Configure(BoardIndex, AO0, BIPOLAR_OUT, INTERNAL_REF, REF_VOLTAGE, UPDATE_WHEN_WRITTEN);
AO_Configure(BoardIndex, AO1, BIPOLAR_OUT, INTERNAL_REF, REF_VOLTAGE, UPDATE_WHEN_WRITTEN);
AO_Configure(BoardIndex, AO2, BIPOLAR_OUT, INTERNAL_REF, REF_VOLTAGE, UPDATE_WHEN_WRITTEN);
AO_Configure(BoardIndex, AO3, BIPOLAR_OUT, INTERNAL_REF, REF_VOLTAGE, UPDATE_WHEN_WRITTEN);
WFM_DB_Config(BoardIndex, 2, @dummy, DISABLE_DOUBLE_BUFFERING, 0, 0);
{DMA transfer: as many samples in FIFO as possible}
AO_Change_Parameter(BoardIndex, ALL_CHANNELS, ND_DATA_TRANSFER_CONDITION, ND_FIFO_HALF_FULL_OR_LESS_UNTIL_FULL);
{No interrupts}
AO_Change_Parameter(BoardIndex, ALL_CHANNELS, ND_LINK_COMPLETE_INTERRUPTS, ND_OFF);
{ Set_DAQ_Device_Info (deviceIndex, ND_AI_FIFO_INTERRUPTS , ND_INTERRUPT_HALF_FIFO);}
{------------------------ Configure RTSI signals ------------------------}
{Sets source of GPCTR0 to 20 MHz}
GPCTR_Change_Parameter(BoardIndex, ND_COUNTER_0, ND_SOURCE, ND_INTERNAL_20_MHZ);
{Puts 20 MHz clock on RTSI_0}
Select_Signal(BoardIndex, ND_RTSI_0, ND_GPCTR0_SOURCE, ND_LOW_TO_HIGH);
{Puts start of acquisition on RTSI_1}
Select_Signal(BoardIndex, ND_RTSI_1, ND_IN_SCAN_START, ND_LOW_TO_HIGH);
{----------------- Photon counting -------------------}
{Puts conversion signal on RTSI_2}
Select_Signal(BoardIndex, ND_RTSI_2, ND_IN_CONVERT, ND_HIGH_TO_LOW);
{Puts scan in progress signal on RTSI_3: precedes conversion}
// Select_Signal(BoardIndex, ND_RTSI_3, ND_IN_SCAN_IN_PROG, ND_LOW_TO_HIGH);
{Puts scan clock on RTSI 4: goes low after conversion}
// Select_Signal(BoardIndex, RTSI_4, ND_SCANCLK, ND_LOW_TO_HIGH);
end
else
fDeviceState := dsNotInstalled;
end;
function TMultifunctionBoard.GetT1(mirror: integer): integer;
begin
Result := T1Array[mirror];
end;
function TMultifunctionBoard.GetT2(mirror: integer): integer;
begin
Result := T2Array[mirror];
end;
function TMultifunctionBoard.GetDeltaT(mirror: integer): integer;
begin
Result := DeltaTArray[mirror];
end;
procedure TMultifunctionBoard.SetBoardIndex(newIndex: integer);
begin
multifunctionBoardIndex := newIndex;
end;
procedure TMultifunctionBoard.SetT1(mirror: integer; value: integer);
begin
T1Array[mirror] := value;
end;
procedure TMultifunctionBoard.SetT2(mirror: integer; value: integer);
begin
T2Array[mirror] := value;
end;
procedure TMultifunctionBoard.SetDeltaT(mirror: integer; value: integer);
begin
DeltaTArray[mirror] := value;
end;
constructor TMultifunctionBoard.Create;
begin
name := sPCI_6110E;
Connect;
end;
{***************************** TAnalogOutputBoard *****************************}
procedure TAnalogOutputBoard.AllocateStimBuffer;
begin
DestroyStimBuffer;
cStimBufferSize := GetTotalSampleCount(analogStimParams);
GetMem(pStimBuffer, cStimBufferSize * SizeOf(int16));
end;
function TAnalogOutputBoard.AnalogToDigital(chIndex: integer; value: double): int16;
begin
try
with analogStimParams do
{10 V = 2048 }
Result := Round(2048 * (value - chOffsets[chIndex]) / chConvFactors[chIndex] / OutputRange);
except
MessageDlg('Invalid analog value.', mtError, [mbOK], 0);
Result := 0;
end;
end;
procedure TAnalogOutputBoard.DestroyStimBuffer;
begin
if cStimBufferSize > 0 then
begin
FreeMem(pStimBuffer, cStimBufferSize * SizeOf(int16));
cStimBufferSize := 0;
end;
end;
function TAnalogOutputBoard.GetAnalogChConvFactors(chIndex: integer): double;
begin
Result := fAnalogChConvFactors[chIndex];
end;
function TAnalogOutputBoard.GetAnalogChNames(chIndex: integer): string;
begin
Result := fAnalogChNames[chIndex];
end;
function TAnalogOutputBoard.GetAnalogChPrefixes(chIndex: integer): TPrefix;
begin
Result := fAnalogChPrefixes[chIndex];
end;
function TAnalogOutputBoard.GetAnalogChUnits(chIndex: integer): string;
begin
Result := fAnalogChUnits[chIndex];
end;
function TAnalogOutputBoard.GetAnalogChZeroOffset(chIndex: integer): double;
begin
Result := fAnalogChZeroOffsets[chIndex];
end;
function TAnalogOutputBoard.GetBoardIndex: integer;
begin
Result := analogOutBoardIndex;
end;
function TAnalogOutputBoard.GetInstalled: boolean;
begin
Result := bAnalogOutBoardInstalled;
end;
function TAnalogOutputBoard.GetTotalSampleCount(const newParams: TAnalogStimRec): integer;
var n, i: integer;
cTotalSamples: array[1..2] of integer;
sampleRate: double;
begin
cTotalSamples[1] := 0;
cTotalSamples[2] := 0;
with newParams do
begin
case updateRateIndex of
0: sampleRate := 0.01;
1: sampleRate := 0.1;
2: sampleRate := 1;
3: sampleRate := 10;
else sampleRate := 1;
end;
try
for i := 1 to 2 do
if bChsEnabled[i] then
begin
cTotalSamples[i] := cTotalSamples[i] + Round(durations1[i] / sampleRate);
n := Round(durations2[i] / sampleRate) + Round(durations3[i] / sampleRate);
if stimTypes[i] = Ord(stTrain) then n := n * trainRepeats[i];
cTotalSamples[i] := cTotalSamples[i] + n;
end;
if bChsEnabled[1] and bChsEnabled[2] then
begin
if cTotalSamples[1] >= cTotalSamples[2] then
Result := 2 * cTotalSamples[1]
else
Result := 2 * cTotalSamples[2];
end
else if bChsEnabled[1] then
Result := cTotalSamples[1]
else
Result := cTotalSamples[2];
except
Result := -1;
end;
end;
end;
procedure TAnalogOutputBoard.ReloadStimParams;
type TSamplePair = array[1..2] of int16;
TFramePair = array[0..MaxInt div 8] of TSamplePair;
TpFramePair = ^TFramePair;
var cSamples, i, j, cSamplesInSegment, chIndex: integer;
lastValues: array[1..2] of int16;
cSamplesInBuffer: array[1..2] of integer;
b2Channels: boolean;
clockRate: double;
begin
cSamples := GetTotalSampleCount(analogStimParams);
with analogStimParams do
begin
b2Channels := bChsEnabled[1] and bChsEnabled[2];
if b2Channels then cSamples := cSamples div 2;
case updateRateIndex of
0: clockRate := 0.01;
1: clockRate := 0.1;
2: clockRate := 1;
3: clockRate := 10;
else clockRate := 1;
end;
for chIndex := 1 to 2 do
begin
cSamplesInBuffer[chIndex] := 0;
case stimTypes[chIndex] of
0: {Seal}
begin
{First level}
cSamplesInSegment := Round(durations1[chIndex]/clockRate);
lastValues[chIndex] := AnalogToDigital(chIndex, amplitude1[chIndex]);
if not b2Channels then
for i := 0 to cSamplesInSegment - 1 do
pStimBuffer^[i + cSamplesInBuffer[chIndex]] := lastValues[chIndex]
else
for i := 0 to cSamplesInSegment - 1 do
TpFramePair(pStimBuffer)^[i + cSamplesInBuffer[chIndex]][chIndex]
:= lastValues[chIndex];
cSamplesInBuffer[chIndex] := cSamplesInBuffer[chIndex] + cSamplesInSegment;
{second level}
cSamplesInSegment := Round(durations2[chIndex]/clockRate);
lastValues[chIndex] := AnalogToDigital(chIndex, amplitude2[chIndex]);
if not b2Channels then
for i := 0 to cSamplesInSegment - 1 do
pStimBuffer^[i + cSamplesInBuffer[chIndex]] := lastValues[chIndex]
else
for i := 0 to cSamplesInSegment - 1 do
TpFramePair(pStimBuffer)^[i + cSamplesInBuffer[chIndex]][chIndex]
:= lastValues[chIndex];
cSamplesInBuffer[chIndex] := cSamplesInBuffer[chIndex] + cSamplesInSegment;
end;
1: {Train}
begin
{First level}
cSamplesInSegment := Round(durations1[chIndex]/clockRate);
lastValues[chIndex] := AnalogToDigital(chIndex, amplitude1[chIndex]);
if not b2Channels then
for i := 0 to cSamplesInSegment - 1 do
pStimBuffer^[i + cSamplesInBuffer[chIndex]] := lastValues[chIndex]
else
for i := 0 to cSamplesInSegment - 1 do
TpFramePair(pStimBuffer)^[i + cSamplesInBuffer[chIndex]][chIndex]
:= lastValues[chIndex];
cSamplesInBuffer[chIndex] := cSamplesInBuffer[chIndex] + cSamplesInSegment;
{second and third levels, repeated trainRepeats time}
for j := 0 to trainRepeats[chIndex] - 1 do
begin
{second level}
cSamplesInSegment := Round(durations2[chIndex]/clockRate);
lastValues[chIndex] := AnalogToDigital(chIndex, amplitude2[chIndex]);
if not b2Channels then
for i := 0 to cSamplesInSegment - 1 do
pStimBuffer^[i + cSamplesInBuffer[chIndex]] := lastValues[chIndex]
else
for i := 0 to cSamplesInSegment - 1 do
TpFramePair(pStimBuffer)^[i + cSamplesInBuffer[chIndex]][chIndex]
:= lastValues[chIndex];
cSamplesInBuffer[chIndex] := cSamplesInBuffer[chIndex] + cSamplesInSegment;
{third level}
cSamplesInSegment := Round(durations3[chIndex]/clockRate);
lastValues[chIndex] := AnalogToDigital(chIndex, amplitude3[chIndex]);
if not b2Channels then
for i := 0 to cSamplesInSegment - 1 do
pStimBuffer^[i + cSamplesInBuffer[chIndex]] := lastValues[chIndex]
else
for i := 0 to cSamplesInSegment - 1 do
TpFramePair(pStimBuffer)^[i + cSamplesInBuffer[chIndex]][chIndex]
:= lastValues[chIndex];
cSamplesInBuffer[chIndex] := cSamplesInBuffer[chIndex] + cSamplesInSegment;
end; {end j}
end;
2: {Incremental}
begin
{First level}
cSamplesInSegment := Round(durations1[chIndex]/clockRate);
lastValues[chIndex] := AnalogToDigital(chIndex, amplitude1[chIndex]);
if not b2Channels then
for i := 0 to cSamplesInSegment - 1 do
pStimBuffer^[i + cSamplesInBuffer[chIndex]] := lastValues[chIndex]
else
for i := 0 to cSamplesInSegment - 1 do
TpFramePair(pStimBuffer)^[i + cSamplesInBuffer[chIndex]][chIndex]
:= lastValues[chIndex];
cSamplesInBuffer[chIndex] := cSamplesInBuffer[chIndex] + cSamplesInSegment;
{second level: amplitude is curamplitudes }
cSamplesInSegment := Round(durations2[chIndex]/clockRate);
lastValues[chIndex] := AnalogToDigital(chIndex, curamplitudes[chIndex]);
if not b2Channels then
for i := 0 to cSamplesInSegment - 1 do
pStimBuffer^[i + cSamplesInBuffer[chIndex]] := lastValues[chIndex]
else
for i := 0 to cSamplesInSegment - 1 do
TpFramePair(pStimBuffer)^[i + cSamplesInBuffer[chIndex]][chIndex]
:= lastValues[chIndex];
cSamplesInBuffer[chIndex] := cSamplesInBuffer[chIndex] + cSamplesInSegment;
{third level}
cSamplesInSegment := Round(durations3[chIndex]/clockRate);
lastValues[chIndex] := AnalogToDigital(chIndex, amplitude3[chIndex]);
if not b2Channels then
for i := 0 to cSamplesInSegment - 1 do
pStimBuffer^[i + cSamplesInBuffer[chIndex]] := lastValues[chIndex]
else
for i := 0 to cSamplesInSegment - 1 do
TpFramePair(pStimBuffer)^[i + cSamplesInBuffer[chIndex]][chIndex]
:= lastValues[chIndex];
cSamplesInBuffer[chIndex] := cSamplesInBuffer[chIndex] + cSamplesInSegment;
end;
end;
{Fill rest of buffer}
if b2Channels then
begin
if cSamples > cSamplesInBuffer[chIndex] then
for i := 0 to cSamples - cSamplesInBuffer[chIndex] - 1 do
TpFramePair(pStimBuffer)^[i + cSamplesInBuffer[chIndex]][chIndex] := lastValues[chIndex];
end
else
if cSamples > cSamplesInBuffer[chIndex] then
for i := 0 to cSamples - cSamplesInBuffer[chIndex] - 1 do
pStimBuffer^[i + cSamplesInBuffer[chIndex]] := lastValues[chIndex];
end;
end;
end;
procedure TAnalogOutputBoard.SetAnalogChConvFactors(chIndex: integer; value: double);
begin
fAnalogChConvFactors[chIndex] := value;
end;
procedure TAnalogOutputBoard.SetAnalogChNames(chIndex: integer; value: string);
begin
fAnalogChNames[chIndex] := value;
end;
procedure TAnalogOutputBoard.SetAnalogChPrefixes(chIndex: integer; value: TPrefix);
begin
fAnalogChPrefixes[chIndex] := value;
end;
procedure TAnalogOutputBoard.SetAnalogChUnits(chIndex: integer; value: string);
begin
fAnalogChUnits[chIndex] := value;
end;
procedure TAnalogOutputBoard.SetAnalogChZeroOffset(chIndex: integer; value: double);
begin
fAnalogChZeroOffsets[chIndex] := value;
end;
procedure TAnalogOutputBoard.SetAnalogOutputEnabled(newAnalogOut: boolean);
begin
if newAnalogOut = fAnalogOutputEnabled then Exit;
{ if fAnalogOutputEnabled then
WFM_Group_Control(BoardIndex, 0, AO_START)
else
begin
StopAnalogStimulation;
end;}
if not newAnalogOut then StopAnalogStimulation;
fAnalogOutputEnabled := newAnalogOut;
end;
procedure TAnalogOutputBoard.SetBoardIndex(newIndex: integer);
begin
analogOutBoardIndex := newIndex;
end;
procedure TAnalogOutputBoard.SetInstalled(value: boolean);
begin
bAnalogOutBoardInstalled := value;
end;
procedure TAnalogOutputBoard.AnalogOut(chIndex: integer; value: double);
begin
if fAnalogOutputEnabled then Exit;
AO_Write(BoardIndex, chIndex - 1, AnalogToDigital(chIndex, value));
end;
function TAnalogOutputBoard.ValidateStimParams(const newParams: TAnalogStimRec): boolean;
var cSamples, i: integer;
begin
Result := True;
cSamples := GetTotalSampleCount(newParams);
if (cSamples > FIFOSampleCount) then
begin
MessageDlg('Too many samples in stimulation.', mtError, [mbOK], 0);
Result := False;
end
else if (cSamples < 3) and (cSamples >= 0) then
begin
MessageDlg('Not enough samples in stimulation.', mtError, [mbOK], 0);
Result := False;
end
else if cSamples < 0 then
begin
MessageDlg('Invalid Stimulation Parameter.', mtError, [mbOK], 0);
Result := False;
end;
if Result then
begin
with newParams do
for i := 1 to 2 do
begin
AnalogChConvFactors[i] := chConvFactors[i];
AnalogChNames[i] := chNames[i];
AnalogChPrefixes[i] := chPrefixes[i];
AnalogChUnits[i] := chUnits[i];
AnalogChZeroOffsets[i] := chOffsets[i];
end;
analogStimParams := newParams;
end;
end;
function TAnalogOutputBoard.LoadAnalogStimParams(const newParams: TAnalogStimRec): boolean;
var interval, iterations: integer;
numChans: int16;
channelVect: array[0..1] of int16;
begin
Result := ValidateStimParams(newParams);
if Result then
if AnalogOutputEnabled and (deviceStatus = dsDetected) then
with analogStimParams do
begin
curamplitudes[1] := amplitude2[1];
curamplitudes[2] := amplitude2[2];
AllocateStimBuffer;
ReloadStimParams;
case updateRateIndex of
0: interval := 1;
1: interval := 10;
2: interval := 100;
3: interval := 1000;
else interval := 100;
end;
{Make sure that the analog output clock is internal}
Select_Signal(analogOutputBoard.BoardIndex, ND_OUT_UPDATE_CLOCK_TIMEBASE,
ND_INTERNAL_100_KHZ, ND_LOW_TO_HIGH);
WFM_ClockRate(BoardIndex, MPUnit.GROUP_1, UPDATE_CLOCK, TIMEBASE_100KHZ, interval, MODE_0);
{Load stimulation}
channelVect[0] := 0;
channelVect[1] := 1;
if bNolimit then iterations := 0 else iterations := repeatCount;
if bChsEnabled[1] and bChsEnabled[2] then numChans := 2 else numChans := 1;
WFM_Load(BoardIndex, numChans, @channelVect, pi16(pStimBuffer), cStimBufferSize, iterations, ENABLE_FIFO_MODE);
end;
end;
procedure TAnalogOutputBoard.Connect;
var dummy: array[0..1] of int16;
begin
if not Installed then
fDeviceState := dsNotInstalled
else if Init_DA_Brds(BoardIndex, @deviceCode) <> 0 then
fDeviceState := dsNotFound
else if (deviceCode = PCI_6711) or (deviceCode = PXI_6733) then
begin
if (deviceCode = PXI_6733) then name := 'sPXI_6733';
fDeviceState := dsDetected;
{------------------------ Configure Digital out ------------------------}
DIG_Prt_Config(BoardIndex, PORT_0, NO_HANDSHAKING, DIGITAL_OUTPUT);
{------------------------ Configure Analog out -------------------------}
AO_Configure(BoardIndex, AO0, BIPOLAR_OUT, INTERNAL_REF, REF_VOLTAGE, UPDATE_WHEN_WRITTEN);
AO_Configure(BoardIndex, AO1, BIPOLAR_OUT, INTERNAL_REF, REF_VOLTAGE, UPDATE_WHEN_WRITTEN);
AO_Configure(BoardIndex, AO2, BIPOLAR_OUT, INTERNAL_REF, REF_VOLTAGE, UPDATE_WHEN_WRITTEN);
AO_Configure(BoardIndex, AO3, BIPOLAR_OUT, INTERNAL_REF, REF_VOLTAGE, UPDATE_WHEN_WRITTEN);
WFM_DB_Config(BoardIndex, 2, @dummy, DISABLE_DOUBLE_BUFFERING, 0, 0);
{------------------------ Configure RTSI -------------------------}
{Clock is RTSI_0}
Select_Signal(BoardIndex, ND_OUT_UPDATE_CLOCK_TIMEBASE, ND_RTSI_0, ND_LOW_TO_HIGH);
{Start of data out is RTSI_1}
Select_Signal(BoardIndex, ND_OUT_START_TRIGGER, ND_RTSI_1, ND_LOW_TO_HIGH);
{Photon counting handshaking signals on RTSI 2 and RTSI 3}
Select_Signal(BoardIndex, ND_OUT_START_TRIGGER, ND_RTSI_2, ND_LOW_TO_HIGH);
Select_Signal(BoardIndex, ND_OUT_START_TRIGGER, ND_RTSI_3, ND_LOW_TO_HIGH);
end
else
fDeviceState := dsNotInstalled;
end;
function TAnalogOutputBoard.DigitalToAnalog(chIndex: integer; value: int16): double;
begin
Result := PrefixToFactor(AnalogChPrefixes[chIndex]) *
(AnalogChConvFactors[chIndex] * OutputRange * value / 2048
+ AnalogChZeroOffsets[chIndex]);
end;
function TAnalogOutputBoard.OpenAnalogStimulation(const stimFilename: string): boolean;
var iniFile: TIniFile; i: integer;
begin
iniFile := TIniFile.Create(stimFilename);
try
Result := LoadAnalogStimFile(analogStimParams, iniFile);
if Result then
begin
for i := 1 to 2 do
begin
fAnalogChConvFactors[i] := analogStimParams.chConvFactors[i];
fAnalogChNames[i] := analogStimParams.chNames[i];
fAnalogChPrefixes[i] := analogStimParams.chPrefixes[i];
fAnalogChUnits[i] := analogStimParams.chUnits[i];
fAnalogChZeroOffsets[i] := analogStimParams.chOffsets[i];
end;
analogStimParams.filename := stimFilename;
end;
finally
iniFile.Free;
end;
end;
procedure TAnalogOutputBoard.SaveAnalogStimulation(const stimFilename: string);
var iniFile: TIniFile;
begin
iniFile := TIniFile.Create(stimFilename);
try
SaveAnalogStimFile(analogStimParams, iniFile);
finally
iniFile.Free;
end;
end;
procedure TAnalogOutputBoard.StartAnalogStimulation;
begin
if AnalogOutputEnabled and (deviceStatus = dsDetected) then
WFM_Group_Control(BoardIndex, 1, AO_START)
end;
function TAnalogOutputBoard.StopAnalogStimulation: boolean;
begin
Result := True;
if AnalogOutputEnabled and (deviceStatus = dsDetected) then
begin
WFM_Group_Control(BoardIndex, 1, AO_CLEAR);
{prepare for next round}
with analogStimParams do
begin
{incremental mode is prerequisite}
if bChsEnabled[1] and (stimTypes[1] = Ord(stIncrement)) then
begin
curamplitudes[1] := curamplitudes[1] + ampincrements[1];
if ampincrements[1] >= 0 then
begin
if curamplitudes[1] > toamplitudes[1] then
curamplitudes[1] := toamplitudes[1]
else
Result := False;
end
else
begin
if curamplitudes[1] < toamplitudes[1] then
curamplitudes[1] := toamplitudes[1]
else
Result := False;
end;
end;
if bChsEnabled[2] and (stimTypes[2] = Ord(stIncrement)) then
begin
curamplitudes[2] := curamplitudes[2] + ampincrements[2];
if ampincrements[2] >= 0 then
begin
if curamplitudes[2] > toamplitudes[2] then
curamplitudes[2] := toamplitudes[2]
else
Result := False;
end
else
begin
if curamplitudes[2] < toamplitudes[2] then
curamplitudes[2] := toamplitudes[2]
else
Result := False;
end;
end;
if ((stimTypes[1] = Ord(stIncrement)) or (stimTypes[2] = Ord(stIncrement))) and not Result then
LoadAnalogStimParams(analogStimParams);
end;
end;
{Returns False only if stimTypes were 2 (incremental), curamplitudes are valid
and scan trigger is Analog stimulation}
{Result := Result or not (Mainform.Configuration.ScanTrigger = stAnalogStimulation);}
{ fAnalogOutputEnabled := Result;}
{Mainform.Button5.Down := Result;}
end;
constructor TAnalogOutputBoard.Create;
begin
fOutputRange := 10;
FIFOSampleCount := 8192;
name := 'PCI-6711';
with analogStimParams do
begin
updateRateIndex := 2; {1 ms}
repeatCount := 1;
bNolimit := False;
bChsEnabled[1]:= True; bChsEnabled[2]:= True;
chNames[1]:= AnalogChNames[1]; chNames[2]:= AnalogChNames[2];
chUnits[1]:= AnalogChUnits[1]; chUnits[2]:= AnalogChUnits[2];
chPrefixes[1]:= AnalogChPrefixes[1]; chPrefixes[2]:= AnalogChPrefixes[2];
chConvFactors[1]:= AnalogChConvFactors[1]; chConvFactors[2]:= AnalogChConvFactors[2];
chOffsets[1]:= AnalogChZeroOffsets[1]; chOffsets[2]:= AnalogChZeroOffsets[2];
holdingValues[1]:= 0; holdingValues[2]:= 0;
trainRepeats[1]:= 1; trainRepeats[2]:= 1;
stimTypes[1]:= 1; stimTypes[2]:= 1; {0: seal, 1: train, 2: incremental}
durations1[1]:= 10; durations1[2]:= 10;
durations2[1]:= 10; durations2[2]:= 10;
durations3[1]:= 10; durations3[2]:= 10;
amplitude1[1]:= 0; amplitude1[2]:= 0;
amplitude2[1]:= 1; amplitude2[2]:= 1;
amplitude3[1]:= 0; amplitude3[2]:= 0;
toamplitudes[1]:= 5; toamplitudes[2]:= 5;
ampincrements[1]:= 4; ampincrements[2]:= 4;
end;
Connect;
LoadAnalogStimParams(analogStimParams); {forces creation of buffers}
end;
destructor TAnalogOutputBoard.Destroy;
begin
DestroyStimBuffer;
inherited Destroy;
end;
{**************************** Optics Output Board *****************************}
function TOpticsOutputBoard.GetBoardIndex: integer;
begin
Result := opticsOutBoardIndex;
end;
function TOpticsOutputBoard.GetInstalled: boolean;
begin
Result := bOpticsOutputBoardInstalled;
end;
procedure TOpticsOutputBoard.SetBoardIndex(newIndex: integer);
begin
opticsOutBoardIndex := newIndex;
end;
procedure TOpticsOutputBoard.SetInstalled(value: boolean);
begin
bOpticsOutputBoardInstalled := value;
end;
{**************************** Photon Counting Board ***************************}
function TPhotonCountingBoard.GetBoardIndex: integer;
begin
Result := PhotonCountingBoardIndex;
end;
function TPhotonCountingBoard.GetInstalled: boolean;
begin
Result := bPhotonCountingBoardInstalled;
end;
procedure TPhotonCountingBoard.SetBoardIndex(newIndex: integer);
begin
PhotonCountingBoardIndex := newIndex;
end;
procedure TPhotonCountingBoard.SetInstalled(value: boolean);
begin
bPhotonCountingBoardInstalled := value;
end;
procedure TPhotonCountingBoard.Connect;
begin
if not Installed then
fDeviceState := dsNotInstalled
else
begin
if Init_DA_Brds(BoardIndex, @deviceCode) <> 0 then
fDeviceState := dsNotFound
else if (deviceCode = PCI_DIO_32HS) or (deviceCode = PCI_6534) then
begin
if deviceCode = PCI_6534 then name := 'PCI-6534';
{Gets REQ1 from RTSI_2}
if RTSI_Conn(BoardIndex, REQ1, RTSI_2, REQ_RECEIVE) <> 0 then
fDeviceState := dsNotInstalled
else
fDeviceState := dsDetected;
// {Gets REQ2 from RTSI_2}
// if RTSI_Conn(BoardIndex, REQ1, RTSI_2, REQ_RECEIVE) <> 0 then
// fDeviceState := dsNotInstalled
// else
// fDeviceState := dsDetected;
end
else
fDeviceState := dsNotInstalled;
end;
end;
constructor TPhotonCountingBoard.Create;
begin
name := sPCI_DIO_32HS;
Connect;
end;
destructor TPhotonCountingBoard.Destroy;
begin
if deviceStatus = dsDetected then
RTSI_Clear(boardIndex);
inherited Destroy;
end;
{******************************** Laser Shutter *******************************}
function TLaserShutter.GetAnalogBoardControlsShutter: boolean;
begin
Result := bAnalogOutBrdControlsShutter;
end;
function TLaserShutter.GetCloseAfterSection: boolean;
begin
Result := bCloseShutterAfterSection;
end;
function TLaserShutter.GetMultifunctionDIOIndex: integer;
begin
Result := multifuncBoardShutterIndex;
end;
function TLaserShutter.GetOpenDelay: integer;
begin
Result := shutterDelay;
end;
procedure TLaserShutter.SetAnalogBoardControlsShutter(value: boolean);
begin
bAnalogOutBrdControlsShutter := Value;
end;
procedure TLaserShutter.SetCloseAfterSection(value: boolean);
begin
bCloseShutterAfterSection := Value;
end;
procedure TLaserShutter.SetMultifunctionDIOIndex(newIndex: integer);
begin
multifuncBoardShutterIndex := newIndex;
end;
procedure TLaserShutter.SetOpenDelay(newDelay: integer);
begin
shutterDelay := newDelay;
end;
procedure TLaserShutter.SetClosed(bClosed: boolean);
var bState: int16;
mask: integer; {added 02-27-08}
begin
if fDeviceState = dsNotInstalled then
fbClosed := False {there is no shutter}
else
if bClosed <> fbClosed then
begin
if bClosed then bState := TTL_LOW else bState := TTL_HIGH;
if bAnalogOutBrdControlsShutter then
DIG_Out_Line(analogOutputBoard.BoardIndex, PORT_0, SHUTTER_LINE, bState)
else
begin
{begin modification 02-27-08}
{sets value of shutter value into digital port}
mask := 1 shl multifuncBoardShutterIndex;
if bState = TTL_HIGH then
multifunctionBoard.fDigitalPort := multifunctionBoard.fDigitalPort or mask
else
multifunctionBoard.fDigitalPort := multifunctionBoard.fDigitalPort and (not mask);
{end modification 02-27-08}
DIG_Out_Line(multifunctionBoard.BoardIndex, PORT_0, multifuncBoardShutterIndex, bState);
end;
Wait(openDelay);
fbClosed := bClosed;
end;
end;
procedure TLaserShutter.Wait(nms: integer);
var oldTime, newTime: integer;
begin
if nms <= 0 then Exit;
{Wait for ~ openDelay ms for the shutter to open or close completely}
oldTime := timeGetTime; {multimedia timer}
repeat
newTime := timeGetTime;
if newTime < oldTime then oldTime := timeGetTime; {wrap around every 49.1 days...}
until newTime > oldTime + nms;
end;
procedure TLaserShutter.OpenShutter;
begin
Closed := False;
end;
procedure TLaserShutter.Connect;
begin
if AnalogBoardControlsShutter then
begin
if analogOutputBoard.deviceStatus = dsDetected then
fDeviceState := dsDetected
else
fDeviceState := dsNotInstalled;
end
else
fDeviceState := dsDetected;
end;
constructor TLaserShutter.Create;
begin
autoObject := TMPLaserShutter.Create;
name := 'Laser Shutter';
Connect;
end;
destructor TLaserShutter.Destroy;
begin
autoObject := nil;
inherited Destroy;
end;
{
procedure TOriginalShutter.SetDeviceState(newState: TDeviceState);
begin
end;
}
{********************************** Z-Stepper *********************************}
function TZStepper.GetCOMPort: integer;
begin
Result := zStepperCOMPort;
end;
function TZStepper.GetCOMSpeed: integer;
begin
Result := zStepperCOMSpeed;
end;
function TZStepper.GetInvertZ: boolean;
begin
Result := zStepperInvert;
end;
procedure TZStepper.OnMoveStarted;
begin
Screen.Cursor := crHourGlass;
Mainform.Shape4.Brush.Color := clRed;
Mainform.Shape4.Refresh;
end;
procedure TZStepper.OnMoveFinished;
begin
Mainform.Shape4.Brush.Color :=clLime;
Mainform.Shape4.Refresh;
Mainform.UpdateZCaptions;
Screen.Cursor := crDefault;
end;
procedure TZStepper.SetCOMPort(value: integer);
begin
zStepperCOMPort := value;
end;
procedure TZStepper.SetCOMSpeed(value: integer);
begin
zStepperCOMSpeed := value;
end;
procedure TZStepper.SetInvertZ(value: boolean);
begin
zStepperInvert := value;
end;
procedure TZStepper.SetSpeed(newspeed: integer);
begin
if (newspeed < 1) or (newspeed > 20) then Exit;
zStepperSpeed := newSpeed;
end;
procedure TZStepper.SetZPosition(newPos: double);
begin
SetZ(newPos);
end;
function TZStepper.GetSpeed: integer;
begin
Result := zStepperSpeed;
end;
procedure TZStepper.GetZ(var newZ: double);
begin
newZ := newZ;
end;
procedure TZStepper.MoveToRelativeZ(newDeltaZ: double);
begin
if not fBusy then
begin
OnMoveStarted;
if InvertZ then newDeltaZ := -newDeltaZ;
fZPosition := fzPosition + newDeltaZ;
end;
end;
procedure TZStepper.SetZ(var newZ: double);
begin
if fBusy then Exit;
OnMoveStarted;
// fZPosition := newZ;
end;
function TZStepper.TravelTime(zTravel: integer; speedIndex: integer): double;
begin
Result := 0;
end;
procedure TZStepper.StartFastScan;
begin
bFastScanInProgress := True;
end;
procedure TZStepper.StopFastScan;
begin
bFastScanInProgress := False;
end;
procedure TZStepper.StopMove;
begin
if bTimerActive then timeKillEvent(zTimer);
bTimerActive := False;
end;
{synchronous call}
procedure TZStepper.MoveToZ(newZ: double);
begin
OnMoveStarted;
end;
{synchronous call}
function TZStepper.ReadZ: double;
begin
Result := fZPosition;
end;
{synchronous call}
procedure TZStepper.ShiftByZ(deltaZ: double);
begin
OnMoveStarted;
if InvertZ then deltaZ := - deltaZ;
fzPosition := fzPosition + deltaZ;
end;
constructor TZStepper.Create;
var timeCaps: TTimeCaps;
begin
inherited Create;
{ fSpeed := 5;} {5 ms per pulse}
name := 'Z- stepper';
autoObject := TMPZStepper.Create;
if timeGetDevCaps(@timeCaps, SizeOf(TTimeCaps)) = MMSYSERR_NOERROR then
begin
minTimerResolution := Min(Max(timeCaps.wPeriodMin, TARGET_RESOLUTION), timeCaps.wPeriodMax);
maxTimerResolution := timeCaps.wPeriodMax;
timeBeginPeriod(minTimerResolution);
end;
end;
destructor TZStepper.Destroy;
begin
autoObject := nil;
timeEndPeriod(minTimerResolution);
inherited Destroy;
end;
{******************************** Earl's Stepper ******************************}
{procedure TEarlStepper.SetDeviceState(newState: TDeviceState);
begin
fDeviceState := dsDetected;
end;}
procedure TEarlStepper.Connect;
begin
fDeviceState := dsDetected;
end;
procedure TEarlStepper.SetSpeed(newspeed: integer);
begin
if fBusy then Exit;
inherited SetSpeed(newspeed);
end;
procedure TEarlStepper.GetZ(var newZ: double);
begin
newZ := ZPosition;
Mainform.UpdateZCaptions;
end;
const
UP_SEQUENCE = $FE; {first bit low}
DOWN_SEQUENCE = $FD;
RESET_SEQUENCE = $FF;
procedure MovingZCallback(uTimerID, uMessage: UINT; dwUser, dw1, dw2: DWORD) stdcall;
begin
with TEarlStepper(dwUser) do
begin
if Odd(curZsequenceCount) then
DIG_Out_Prt(multifunctionBoard.boardIndex, PORT_0, zPattern or multifunctionBoard.DigitalPort)
else
DIG_Out_Prt(multifunctionBoard.boardIndex, PORT_0, RESET_SEQUENCE or multifunctionBoard.DigitalPort);
curZsequenceCount := curZsequenceCount + 1;
if curZsequenceCount >= zsequenceCount then
begin
if bTimerActive then timeKillEvent(zTimer);
bTimerActive := False;
OnMoveFinished;
fBusy := False;
end;
end;
end;
procedure TEarlStepper.MoveToRelativeZ(newDeltaZ: double);
begin
if not fBusy then
begin
inherited MoveToRelativeZ(newDeltaZ);
if InvertZ then newDeltaZ := - newDeltaZ;
fBusy := True;
{creates a digital pattern: converts microns into steps}
zSequenceCount := 2 * Round(Abs(newDeltaZ) / stepSize);
curZsequenceCount := 0;
if newDeltaZ < 0 then zPattern := DOWN_SEQUENCE else zPattern := UP_SEQUENCE;
bTimerActive := True;
zTimer := timeSetEvent(21 - Speed {2 ms / step}, 0, MovingZCallback, DWORD(self), TIME_PERIODIC);
end;
end;
procedure EarlFastStackCallback(uTimerID, uMessage: UINT; dwUser, dw1, dw2: DWORD) stdcall;
var newPower: double;
currentDisplacement: double;
begin
with TEarlStepper(dwUser) do
begin
if Odd(curZsequenceCount) then
begin
DIG_Out_Prt(multifunctionBoard.boardIndex, PORT_0, zPattern or multifunctionBoard.DigitalPort);
if zPattern = UP_SEQUENCE then
fZPosition := fZPosition + stepSize
else
fZPosition := fZPosition - stepSize;
end
else
DIG_Out_Prt(multifunctionBoard.boardIndex, PORT_0, RESET_SEQUENCE or multifunctionBoard.DigitalPort);
curZsequenceCount := curZsequenceCount + 1;
{Adjust laser power here}
with Mainform.Configuration, Mainform.engine do
if IntensityControl <> IC_NO_CONTROL then
begin
currentDisplacement := - startFastScanPosition + fZPosition;
if IntensityControl = IC_LINEAR then
newPower := currentDisplacement * (FinalIntensity - InitialIntensity)/AtZDistance
+ InitialIntensity
else
begin
if InitialIntensity <= 0 then InitialIntensity := 1;
newPower := InitialIntensity *
exp(currentDisplacement * Ln(FinalIntensity/InitialIntensity) / AtZDistance);
end;
if Abs(newPower- LaserControl.Power) > 0 then
begin
analogOutputBoard.AnalogOut(1, newPower/10);
LaserControl.Power := newPower;
end;
end;
if curZsequenceCount >= zsequenceCount then
begin
curFastRepeatCount := curFastRepeatCount + 1;
if curFastRepeatCount >= Mainform.Configuration.FastStackRepeatCount then
begin
if bTimerActive then timeKillEvent(zTimer);
bTimerActive := False;
bFastScanInProgress := False;
PostMessage(Mainform.Handle, WM_FASTSTACK_ENDED, 0, 0);
end
else
begin
{we invert the pattern here and go backwards}
if zPattern = DOWN_SEQUENCE then zPattern := UP_SEQUENCE else
zPattern := DOWN_SEQUENCE;
curZsequenceCount := 0;
end;
end;
end;
end;
procedure TEarlStepper.StartFastScan;
begin
inherited StartFastScan;
startFastScanPosition := ZPosition;
with Mainform.configuration do
begin
zSequenceCount := 2 * Round(Abs(zDistance) / stepSize);
curZsequenceCount := 0;
curFastRepeatCount := 0;
if zDistance < 0 then zPattern := DOWN_SEQUENCE else zPattern := UP_SEQUENCE;
{The timer is set to fire every 61 - TravelSpeed millisecond}
bTimerActive := True;
zTimer := timeSetEvent(61 - TravelSpeed, 0, EarlFastStackCallback, DWORD(self), TIME_PERIODIC);
end;
end;
procedure TEarlStepper.StopFastScan;
begin
if not bFastScanInProgress then Exit;
if bTimerActive then timeKillEvent(zTimer);
bTimerActive := False;
inherited StopFastScan;
end;
procedure TEarlStepper.SetZ(var newZ: double);
var newDeltaZ: double;
begin
newDeltaZ := newZ - ZPosition;
inherited SetZ(newZ);
MoveToRelativeZ(newDeltaZ);
repeat
Application.ProcessMessages;
until not Busy;
end;
function TEarlStepper.TravelTime(zTravel: integer; speedIndex: integer): double;
begin
{speedIndex = 1: slowest, speed index = 60: fastest}
{8: conversion to 1/8 microns
2: Low and High
61 - speedIndex: duration in ms of a pulse}
Result := Abs(zTravel) * 8 * 2 * (61 - speedIndex) / 1000;
end;
procedure TEarlStepper.MoveToZ(newZ: double);
begin
SetZ(newZ);
end;
function TEarlStepper.ReadZ: double;
begin
Result := ZPosition;
end;
procedure TEarlStepper.ShiftByZ(deltaZ: double);
begin
MoveToRelativeZ(deltaZ);
repeat
Application.ProcessMessages;
until not Busy;
end;
constructor TEarlStepper.Create;
begin
inherited Create;
fDeviceState := dsDetected;
name := 'Earl''s stepper';
{ fSpeed := 5; }{5 ms per pulse}
fStepSize := 0.125;
end;
destructor TEarlStepper.Destroy;
begin
inherited Destroy;
end;
{********************************** TZMP285 *********************************}
function TZMP285.GetDeviceState: TDeviceState;
begin
Result := xyzMP285.GetDeviceState;
end;
procedure TZMP285.Connect;
begin
xyzMP285.Connect;
end;
procedure TZMP285.SetSpeed(speedIndex: integer);
begin
xyzMP285.SetSpeed(speedIndex);
end;
procedure TZMP285.GetZ(var newZ: double);
begin
xyzMP285.GetXYZ; {returns values in zStepper and XYTable}
newZ := fzPosition;
end;
procedure TZMP285.MoveToRelativeZ(newDeltaZ: double);
begin
if not fBusy then
begin
{updates current position}
xyzMP285.GetXYZ;
inherited MoveToRelativeZ(newDeltaZ); {updates fZPosition}
fBusy := True;
{returns values in zStepper and XYTable}
xyzMP285.SetXYZ(xyTable.fXPosition, xyTable.fYPosition, fZPosition);
end;
end;
{Asynchronous call}
procedure TZMP285.SetZ(var newZ: double);
begin
if not fBusy then
begin
{updates current position}
xyzMP285.GetXYZ;
inherited SetZ(newZ);
xyzMP285.SetXYZ(xyTable.fXPosition, xyTable.fYPosition, fZPosition);
newZ := fZPosition;
end;
end;
{Synchronous call}
procedure TZMP285.MoveToZ(newZ: double);
begin
if not fBusy then
begin
{updates current position}
xyzMP285.GetXYZ;
inherited MoveToZ(newZ);
fBusy := True;
xyzMP285.SetXYZ(xyTable.fXPosition, xyTable.fYPosition, fZPosition);
repeat
Application.ProcessMessages;
{xyzTriggerData sets fBusy flags to False}
until not Busy;
end;
end;
function TZMP285.ReadZ: double;
begin
if not fBusy then
begin
xyzMP285.GetXYZ;
Result := fZPosition;
end
else
Result := 0;
end;
{synchronous calls; returns when complete}
procedure TZMP285.ShiftByZ(deltaZ: double);
begin
if not fBusy then
begin
xyzMP285.GetXYZ;
inherited ShiftByZ(deltaZ);
fBusy := True;
xyzMP285.SetXYZ(XYTable.fXPosition, XYTable.fYPosition, ZStepper.fzPosition);
repeat
Application.ProcessMessages;
until not Busy;
end;
end;
function TZMP285.TravelTime(zTravel: integer; speedIndex: integer): double;
begin
{2.9 mm / s: max speed of MP-285}
{speedIndex = 1: slowest, speed index = 60: fastest: 1 step / 20 ms : 10 um/s}
{1 um = 5 steps; minimal callback time: 20 ms (because of serial port)}
{80 - speedIndex: callback time (in ms)}
Result := 5 {microns/step} * Abs(zTravel) * (80 - speedIndex) / 1000;
end;
procedure ZMP285FastStackCallback(uTimerID, uMessage: UINT; dwUser, dw1, dw2: DWORD) stdcall;
var newPower: integer;
currentDisplacement: double;
begin
with TZMP285(dwUser) do
begin
if not Odd(curFastRepeatCount) and (Mainform.Configuration.zDistance < 0) then
fZPosition := fZPosition - stepSize
else
fZPosition := fZPosition + stepSize;
xyzMP285.SetXYZFast(XYTable.XPosition, XYTable.YPosition, ZPosition);
{Adjust laser power here}
with Mainform.Configuration, Mainform.engine do
if IntensityControl <> IC_NO_CONTROL then
begin
currentDisplacement := - startFastScanPosition + fZPosition;
if IntensityControl = IC_LINEAR then
newPower := Round(currentDisplacement * (FinalIntensity - InitialIntensity)/AtZDistance
+ InitialIntensity)
else
begin
if InitialIntensity <= 0 then InitialIntensity := 1;
newPower := Round(InitialIntensity *
exp(currentDisplacement * Ln(FinalIntensity/InitialIntensity) / AtZDistance));
end;
if Abs(newPower- LaserControl.Power) > 0 then LaserControl.Power := newPower;
end;
if (ZPosition = startFastScanPosition + Mainform.Configuration.zDistance) or
(ZPosition = startFastScanPosition) then
begin
curFastRepeatCount := curFastRepeatCount + 1;
if curFastRepeatCount >= Mainform.Configuration.FastStackRepeatCount then
begin
if bTimerActive then timeKillEvent(zTimer);
bTimerActive := False;
bFastScanInProgress := False;
PostMessage(Mainform.Handle, WM_FASTSTACK_ENDED, 0, 0);
end;
end;
end;
end;
procedure TZMP285.StartFastScan;
begin
inherited StartFastScan;
GetZ(startFastScanPosition); {we get the initial position}
with Mainform.configuration do
begin
curFastRepeatCount := 0;
{The timer is set to fire every 80 - TravelSpeed millisecond}
bTimerActive := True;
zTimer := timeSetEvent(80 - TravelSpeed, 0, ZMP285FastStackCallback, DWORD(self), TIME_PERIODIC);
end;
end;
procedure TZMP285.StopFastScan;
begin
if not bFastScanInProgress then Exit;
if bTimerActive then timeKillEvent(zTimer);
bTimerActive := False;
inherited StopFastScan;
{enables MP285 no matter what}
end;
constructor TZMP285.Create;
begin
inherited Create;
name := 'Sutter MP-285 Z-Stepper';
{ fSpeed := 5;} {medium speed}
fStepSize := 0.2; {5 microsteps / microns}
end;
destructor TZMP285.Destroy;
begin
FreeAndNil(xyzMP285);
inherited Destroy;
end;
{********************************** X-Y Table *********************************}
function TXYTable.GetCOMPort: integer;
begin
Result := xydeviceCOMPortIndex;
end;
function TXYTable.GetCOMSpeed: integer;
begin
Result := xydeviceCOMSpeedIndex;
end;
function TXYTable.GetInvertX: boolean;
begin
Result := bxydeviceInvertX;
end;
function TXYTable.GetInvertY: boolean;
begin
Result := bxydeviceInvertY;
end;
function TXYTable.GetSpeed: integer;
begin
Result := xydeviceManualSpeed;
end;
procedure TXYTable.OnMoveStarted;
begin
fBusy := True;
Screen.Cursor := crHourGlass;
Mainform.Shape3.Brush.Color := clRed;
Mainform.Shape3.Refresh;
end;
procedure TXYTable.OnMoveFinished;
begin
Mainform.Shape3.Brush.Color := clLime;
Mainform.Shape3.Refresh;
fBusy := False;
Mainform.UpdateXYCaptions;
Screen.Cursor := crDefault;
end;
procedure TXYTable.SetCOMPort(portIndex: integer);
begin
xydeviceCOMPortIndex := portIndex;
end;
procedure TXYTable.SetCOMSpeed(portSpeed: integer);
begin
xydeviceCOMSpeedIndex := portSpeed;
end;
procedure TXYTable.SetInvertX(bInvert: boolean);
begin
bxydeviceInvertX := bInvert;
end;
procedure TXYTable.SetInvertY(bInvert: boolean);
begin
bxydeviceInvertY := bInvert;
end;
procedure TXYTable.SetSpeed(value: integer);
begin
xydeviceManualSpeed := value;
end;
{async}
procedure TXYTable.GetXY(var newX, newY: integer);
begin
newX := 0; newY := 0;
end;
{async}
procedure TXYTable.SetXY(var newX, newY: integer);
begin
OnMoveStarted;
end;
{async}
procedure TXYTable.SetRelativeXY(deltaX, deltaY: integer);
begin
OnMoveStarted;
end;
procedure TXYTable.XYCommand(const sCommand: string);
begin
{do nothing - overriden by classes descending from TXYTable}
end;
procedure TXYTable.GalilWaitForMotionComplete;
begin
{do nothing - overriden by classes descending from TXYTable}
end;
{sync}
procedure TXYTable.MoveToXY(newX, newY: integer);
begin
OnMoveStarted;
end;
{sync}
procedure TXYTable.ReadXY(var x, y: integer);
begin
x := 0; y := 0;
end;
{sync}
procedure TXYTable.ShiftByXY(deltaX, deltaY: integer);
begin
OnMoveStarted;
end;
constructor TXYTable.Create;
begin
inherited Create;
name := 'X-Y Table';
autoObject := TMPXYTable.Create;
end;
destructor TXYTable.Destroy;
begin
autoObject := nil;
inherited Destroy;
end;
{********************************** NEAT 300 *********************************}
const MICRONS_PER_STEP = 508; {0.0508 microns per steps; steps / microns = 10000 / 508}
procedure TNEAT300.TriggerData(CP: TObject; TriggerHandle: Word);
var deltaX, deltaY: integer;
begin
if neatStatus = neatOK then Exit;
if triggerHandle = CaretTriggerHandle then
case neatStatus of
neatTERM3: {we cascade all commands}
begin
{TERM3 string was successfully processed by the NEAT controller
we go to the next command and disable the watchdog timer}
neatStatus := neatMFE; {Move Finished Enabled}
serialPort.SetTimerTrigger(TimerHandle, 32, False);
serialPort.PutString('MFE' + CRLF);
end;
neatMFE:
begin
neatStatus := neatAA; {all axes}
serialPort.PutString('AA' + CRLF);
end;
neatAA:
begin
{skip neatSE to prevent encoders from resetting: 12 Dec 05}
{ neatStatus := neatSE; all axes
serialPort.PutString('SE0,0' + CRLF);
end;
neatSE:
begin }
neatStatus := neatJE; {all axes}
serialPort.PutString('JE1,1' + CRLF);
end;
neatJE:
begin
fDeviceState := dsDetected;
neatStatus := neatOK;
end;
neatREAD:
begin
ParseReturnedString;
if (s1 <> '') and (s2 <> '') then
begin
try
fXPosition := StrToInt(s1);
fYPosition := StrToInt(s2);
except
fXPosition := 0;
fYPosition := 0;
end;
pNewX^ := fXPosition;
pNewY^ := fYPosition;
neatStatus := neatOK;
fBusy := False;
end;
end;
neatREADUPDATE:
begin
ParseReturnedString;
if (s1 <> '') and (s2 <> '') then
begin
try
fXPosition := StrToInt(s1);
fYPosition := StrToInt(s2);
except
fXPosition := 0;
fYPosition := 0;
end;
pNewX^ := fXPosition;
pNewY^ := fYPosition;
neatStatus := neatOK;
OnMoveFinished;
{enables joystick back}
serialPort.PutString('JE1,1' + CRLF);
end;
fBusy := False;
end;
neatREADCLOSELOOP:
begin
ParseReturnedString;
if (s1 <> '') and (s2 <> '') then
begin
try
fXPosition := StrToInt(s1);
fYPosition := StrToInt(s2);
except
fXPosition := 0;
fYPosition := 0;
end;
pNewX^ := fXPosition;
pNewY^ := fYPosition;
deltaX := Muldiv(10000, desiredX - fXposition, MICRONS_PER_STEP);
deltaY := Muldiv(10000, desiredY - fYPosition, MICRONS_PER_STEP);
if ((Abs(deltaX) <= 1) and (Abs(deltaY) <= 1)) or
(iterationCount = MAX_CLOSE_LOOP_ITERATIONS) then
begin
neatStatus := neatOK;
OnMoveFinished;
{enables joystick back}
serialPort.PutString('JE1,1' + CRLF);
fBusy := False;
end
else
begin
neatStatus := neatMOVECLOSELOOP;
serialPort.PutString('MR' + IntToStr(deltaX) + ',' + IntToStr(deltaY) + CRLF);
end;
end;
end;
neatCOMMAND, neatSETSPEED:
begin
fBusy := False;
neatStatus := neatOK;
end;
end
else if triggerHandle = FTriggerHandle then
case neatStatus of
neatMOVE:
begin
neatStatus := neatREADUPDATE;
serialPort.PutString('RE' + CRLF);
end;
neatMOVECLOSELOOP:
begin
iterationCount := iterationCount + 1;
neatstatus := neatREADCLOSELOOP;
serialPort.PutString('RE' + CRLF);
end;
end;
sSerial := '';
if neatStatus = neatOK then fBusy := False;
end;
procedure TNEAT300.TriggerAvail(CP: TObject; Count: Word);
var i: Word;
begin
for i := 1 to Count do
sserial := sserial + serialPort.GetChar;
end;
procedure TNEAT300.ParseReturnedString;
var bFirstComma, bSecondComma: boolean;
i: integer;
c: Char;
begin
bFirstComma := False; bSecondComma := False;
s1 := ''; s2 := ''; s3 := '';
if Length(sSerial) > 1 then
for i := 1 to Length(sSerial) do
begin
{parses the incoming strings by removing commas that separate values}
c := sSerial[i];
if c = ',' then
begin
if not bFirstComma then
bFirstComma := True
else if not bSecondComma then
bSecondComma := True;
end
else if not (Ord(c) in [0..31]) and (c <> 'F') and (c <> '>') and (c in ['0'..'9','+','-']) then
begin
if not bFirstComma then
s1 := s1 + c
else if bFirstComma and not bSecondComma then
s2 := s2 + c
else
s3 := s3 + c;
end;
end;
end;
procedure TNEAT300.TimerReceived(CP: TObject; TriggerHandle: Word);
begin
sSerial := '';
bNoAnswer := True;
fDeviceState := dsNotFound;
fBusy := False;
end;
procedure TNEAT300.SetSpeed(value: integer);
begin
if fBusy then Exit;
if value < 1 then value := 1; if value > 20 then value := 20;
inherited SetSpeed(value);
fBusy := True;
neatStatus := neatSETSPEED;
sSerial := '';
serialPort.PutString('VI ' + IntToStr(value * 2000) + ',' + IntToStr(value * 2000) + CRLF);
repeat
Application.ProcessMessages;
until neatStatus = neatOK;
end;
procedure TNEAT300.GetXY(var newX, newY: integer);
begin
// if fBusy then Exit;
pNewX := @newX;
pNewY := @newY;
fBusy := True;
neatStatus := neatREAD;
sSerial := '';
serialPort.PutString('RE' + CRLF);
end;
procedure TNEAT300.SetXY(var newX, newY: integer);
var curX, curY, deltaX, deltaY: integer;
begin
// if fBusy then Exit;
pNewX := @newX;
pNewY := @newY;
desiredX := newX;
desiredY := newY;
inherited SetXY(newX, newY);
ReadXY(curX, curY);
deltaX := Muldiv(10000, newX - curX, MICRONS_PER_STEP);
deltaY := Muldiv(10000, newY - curY, MICRONS_PER_STEP);
iterationCount := 0;
fBusy := True;
{ if not bFinePrecision then
neatStatus := neatMOVE
else}
neatStatus := neatMOVECLOSELOOP;
sSerial := '';
serialPort.PutString('MR' + IntToStr(deltaX) + ',' + IntToStr(deltaY) + CRLF);
end;
procedure TNEAT300.SetRelativeXY(deltaX, deltaY: integer);
begin
if fBusy then Exit;
inherited SetRelativeXY(deltaX, deltaY);
{ fCallback := callback;
deltaX := Muldiv(10000, deltaX, MICRONS_PER_STEP);
deltaY := Muldiv(10000, deltaY, MICRONS_PER_STEP);
pNewX := @fXPosition;
pNewY := @fYPosition;
fBusy := True;
neatStatus := neatMOVE;
sSerial := '';
serialPort.PutString('MR' + IntToStr(deltaX) + ',' + IntToStr(deltaY) + CRLF);}
ShiftByXY(deltaX, deltaY);
end;
procedure TNEAT300.MoveToXY(newX, newY: integer);
begin
if deviceStatus <> dsDetected then Exit;
inherited MoveToXY(newX, newY);
SetXY(newX, newY);
repeat
Application.ProcessMessages;
until neatStatus = neatOK;
end;
procedure TNEAT300.ReadXY(var x, y: integer);
begin
if deviceStatus <> dsDetected then Exit;
GetXY(x, y);
repeat
Application.ProcessMessages;
until neatStatus = neatOK;
end;
procedure TNEAT300.ShiftByXY(deltaX, deltaY: integer);
var x, y: integer;
begin
if deviceStatus <> dsDetected then Exit;
ReadXY(x, y);
if InvertX then deltaX := - deltaX;
if InvertY then deltaY := - deltaY;
x := deltaX + x;
y := deltaY + y;
SetXY(x, y);
end;
procedure TNEAT300.XYCommand(const sCommand: string);
begin
if fBusy then Exit;
fBusy := True;
neatStatus := neatCOMMAND;
sSerial := '';
serialPort.PutString(sCommand + CRLF);
repeat
Application.ProcessMessages;
until neatStatus = neatOK;
end;
procedure TNEAT300.Connect;
begin
try
with serialPort do
begin
Baud := COMSpeed;
COMNumber := COMPort;
Parity := pNone;
DataBits := 8;
StopBits := 1;
sSerial := '';
serialPort.Open := True;
CaretTriggerHandle := AddDataTrigger('>', False);
FTriggerHandle := AddDataTrigger('F', False);
TimerHandle := AddTimerTrigger;
OnTriggerData := TriggerData;
OnTriggerAvail := TriggerAvail;
OnTriggerTimer := TimerReceived;
end;
try
{We open the serial port and find out if the 'TERM3' command
returns with '>'. If not, timer event occurs and sets bNoAnswer}
{64 * 55 ms time out}
serialPort.SetTimerTrigger(TimerHandle, 64, True);
neatStatus := neatTERM3;
bNoAnswer := False;
fBusy := True;
serialPort.PutString('TERM3' + CRLF);
repeat
Application.ProcessMessages;
until (neatStatus = neatOK) or bNoAnswer;
except
fDeviceState := dsNotFound;
end;
except
fDeviceState := dsNotFound;
end;
end;
constructor TNEAT300.Create;
begin
inherited Create;
name := 'Danaher NEAT 300 X-Y Table';
serialPort := TApdCOMPort.Create(nil);
serialPort.AutoOpen := False;
end;
destructor TNEAT300.Destroy;
begin
serialPort.Free;
inherited Destroy;
end;
{***************************** TXYMP285 *******************************}
function TXYMP285.GetDeviceState: TDeviceState;
begin
Result := xyzMP285.GetDeviceState;
end;
procedure TXYMP285.SetSpeed(value: integer);
begin
xyzMP285.SetSpeed(value);
end;
procedure TXYMP285.Connect;
begin
xyzMP285.Connect;
end;
procedure TXYMP285.GetXY(var newX, newY: integer);
begin
inherited GetXY(newX, newY);
xyzMP285.GetXYZ;
newX := xyTable.fXPosition;
newY := xyTable.fYPosition;
Mainform.UpdateXYCaptions;
end;
procedure TXYMP285.SetXY(var newX, newY: integer);
begin
inherited SetXY(newX, newY);
xyzMP285.SetXYZ(newX, newY, zStepper.fZPosition);
end;
procedure TXYMP285.SetRelativeXY(deltaX, deltaY: integer);
begin
if not fBusy then
begin
{updates current position}
xyzMP285.GetXYZ;
inherited SetRelativeXY(deltaX, deltaY);
xyTable.fXPosition := xyTable.fXPosition + deltaX;
xyTable.fYPosition := xyTable.fYPosition + deltaY;
fBusy := True;
xyzMP285.SetXYZ(xyTable.fXPosition, xyTable.fYPosition, ZStepper.ZPosition);
end;
end;
procedure TXYMP285.MoveToXY(newX, newY: integer);
begin
inherited MoveToXY(newX, newY);
xyzMP285.SetXYZ(newX, newY, zStepper.fZPosition);
end;
procedure TXYMP285.ReadXY(var x, y: integer);
begin
inherited ReadXY(x, y);
xyzMP285.GetXYZ;
x := xyTable.XPosition;
y := xyTable.YPosition;
end;
procedure TXYMP285.ShiftByXY(deltaX, deltaY: integer);
begin
inherited ShiftByXY(deltaX, deltaY);
xyzMP285.SetXYZ(xyTable.fXPosition + deltaX, xyTable.fYPosition + deltaY, zStepper.fZPosition);
end;
procedure TXYMP285.XYCommand(const sCommand: string);
begin
xyzMP285.XYCommand(sCommand);
end;
constructor TXYMP285.Create;
begin
inherited Create;
name := 'Sutter MP-285 X-Y Table';
xyzMP285 := TXYZMP285.Create;
{ xyzMP285.SetResolutionToLow;}
end;
destructor TXYMP285.Destroy;
begin
FreeAndNil(xyzMP285);
inherited Destroy;
end;
{********************************* XYESP300 ***********************************}
function TXYESP300.GetDeviceState: TDeviceState;
begin
Result := xyzESP300.GetDeviceState;
end;
procedure TXYESP300.SetSpeed(value: integer);
begin
inherited SetSpeed(value);
xyzESP300.SetXYSpeed(value);
end;
procedure TXYESP300.Connect;
begin
xyzESP300.Connect;
end;
procedure TXYESP300.GetXY(var newX, newY: integer);
begin
xyzESP300.GetXY(newX, newY);
end;
procedure TXYESP300.SetXY(var newX, newY: integer);
begin
xyzESP300.SetXY(newX, newY);
end;
procedure TXYESP300.SetRelativeXY(deltaX, deltaY: integer);
begin
if InvertX then deltaX := - deltaX;
if InvertY then deltaY := - deltaY;
xyzESP300.SetRelativeXY(deltaX, deltaY);
end;
procedure TXYESP300.MoveToXY(newX, newY: integer);
begin
xyzESP300.MoveToXY(newX, newY);
end;
procedure TXYESP300.ReadXY(var x, y: integer);
begin
inherited ReadXY(x, y);
xyzESP300.ReadXY(x, y);
end;
procedure TXYESP300.ShiftByXY(deltaX, deltaY: integer);
begin
if InvertX then deltaX := - deltaX;
if InvertY then deltaY := - deltaY;
xyzESP300.ShiftByXY(deltaX, deltaY);
end;
procedure TXYESP300.XYCommand(const sCommand: string);
begin
xyzESP300.XYCommand(sCommand);
end;
constructor TXYESP300.Create;
begin
inherited Create;
name := 'Newport ESP300 X-Y Table';
COMSpeed := 19200;
xyzESP300 := TXYZESP300.Create;
end;
destructor TXYESP300.Destroy;
begin
xyzESP300.Free;
inherited Destroy;
end;
{********************************* TZESP300 ***********************************}
function TZESP300.GetDeviceState: TDeviceState;
begin
Result := xyzESP300.GetDeviceState;
end;
procedure TZESP300.Connect;
begin
xyzESP300.Connect;
end;
procedure TZESP300.SetSpeed(speedIndex: integer);
begin
xyzESP300.SetZSpeed(speedIndex);
end;
procedure TZESP300.GetZ(var newZ: double);
begin
xyzESP300.GetZ(newZ);
end;
procedure TZESP300.MoveToRelativeZ(newDeltaZ: double);
begin
xyzESP300.MoveToRelativeZ(newDeltaZ);
end;
procedure TZESP300.SetZ(var newZ: double);
begin
xyzESP300.SetZ(newZ);
end;
procedure TZESP300.MoveToZ(newZ: double);
begin
xyzESP300.MoveToZ(newZ);
end;
function TZESP300.ReadZ: double;
begin
Result := xyzESP300.ReadZ;
end;
procedure TZESP300.ShiftByZ(deltaZ: double);
begin
xyzESP300.ShiftByZ(deltaZ);
end;
function TZESP300.TravelTime(zTravel: integer; speedIndex: integer): double;
begin
Result := 5 {step /micron} * Abs(zTravel) * (80 - speedIndex) / 1000;
end;
procedure ZESP300FastStackCallback(uTimerID, uMessage: UINT; dwUser, dw1, dw2: DWORD) stdcall;
var newPower: integer;
currentDisplacement: double;
begin
with TZMP285(dwUser) do
begin
if not Odd(curFastRepeatCount) and (Mainform.Configuration.zDistance < 0) then
fZPosition := fZPosition - stepSize
else
fZPosition := fZPosition + stepSize;
xyzESP300.MoveToZ(fZPosition);
{Adjust laser power here}
with Mainform.Configuration, Mainform.engine do
if IntensityControl <> IC_NO_CONTROL then
begin
currentDisplacement := - startFastScanPosition + fZPosition;
if IntensityControl = IC_LINEAR then
newPower := Round(currentDisplacement * (FinalIntensity - InitialIntensity)/AtZDistance
+ InitialIntensity)
else
begin
if InitialIntensity <= 0 then InitialIntensity := 1;
newPower := Round(InitialIntensity *
exp(currentDisplacement * Ln(FinalIntensity/InitialIntensity) / AtZDistance));
end;
if Abs(newPower - LaserControl.Power) > 0 then
begin
analogOutputBoard.AnalogOut(1, newPower/10);
LaserControl.Power := newPower;
end;
end;
if (ZPosition = startFastScanPosition + Mainform.Configuration.zDistance) or
(ZPosition = startFastScanPosition) then
begin
curFastRepeatCount := curFastRepeatCount + 1;
if curFastRepeatCount >= Mainform.Configuration.FastStackRepeatCount then
begin
if bTimerActive then timeKillEvent(zTimer);
bTimerActive := False;
bFastScanInProgress := False;
PostMessage(Mainform.Handle, WM_FASTSTACK_ENDED, 0, 0);
end;
end;
end;
end;
procedure TZESP300.StartFastScan;
begin
inherited StartFastScan;
GetZ(startFastScanPosition); {we get the initial position}
with Mainform.configuration do
begin
curFastRepeatCount := 0;
{The timer is set to fire every 80 - TravelSpeed millisecond}
bTimerActive := True;
zTimer := timeSetEvent(80 - TravelSpeed, 0, ZESP300FastStackCallback, DWORD(self), TIME_PERIODIC);
end;
end;
procedure TZESP300.StopFastScan;
begin
if not bFastScanInProgress then Exit;
if bTimerActive then timeKillEvent(zTimer);
bTimerActive := False;
inherited StopFastScan;
end;
constructor TZESP300.Create;
begin
inherited Create;
name := 'Newport ESP300 Z-Stepper';
{ fSpeed := 5;} {medium speed}
fStepSize := 0.2; {0.2 microns / step}
end;
destructor TZESP300.Destroy;
begin
inherited Destroy;
end;
{******************************* TXYZESP300 ***********************************}
procedure TXYZESP300.TriggerData(CP: TObject; TriggerHandle: Word);
begin
serialPort.SetTimerTrigger(TimerHandle, 256, False);
if TriggerHandle <> CRTriggerHandle then Exit;
try
case fESPMode of
ESP300_READING_X: lastX := StrToFloat(sserial);
ESP300_READING_Y: lastY := StrToFloat(sserial);
ESP300_READING_Z: lastZ := StrToFloat(sserial);
end;
except
bMovingError := True;
end;
bReading := False;
sSerial := '';
end;
procedure TXYZESP300.TriggerAvail(CP: TObject; Count: Word);
var i: Word;
begin
for i := 1 to Count do
sserial := sserial + serialPort.GetChar;
end;
procedure TXYZESP300.TimerReceived(CP: TObject; TriggerHandle: Word);
begin
if TriggerHandle = TimerHandle then
begin
sSerial := '';
bReading := False;
fDeviceState := dsNotFound;
end;
end;
procedure TXYZESP300.Connect;
begin
inherited Connect;
try
with serialPort do
begin
Baud := XYTable.COMSpeed;
COMNumber := XYTable.COMPort;
Parity := pNone;
DataBits := 8;
StopBits := 1;
sSerial := '';
serialPort.Open := True;
CRTriggerHandle := AddDataTrigger(Chr(13)+Chr(10), False);
TimerHandle := AddTimerTrigger;
OnTriggerData := TriggerData;
OnTriggerAvail := TriggerAvail;
OnTriggerTimer := TimerReceived;
end;
try
fBusy := True;
{Unit for each axis: micron, encoder resolution: 0.2 micron}
{256 * 55 ms time out}
serialPort.SetTimerTrigger(TimerHandle, 256, True);
bReading := True; fESPMode := ESP300_COMMAND;
serialPort.PutString('1SN3' + Chr(13));
repeat
Application.ProcessMessages;
until not bReading;
serialPort.SetTimerTrigger(TimerHandle, 256, True);
bReading := True; fESPMode := ESP300_COMMAND;
serialPort.PutString('2SN3' + Chr(13));
repeat
Application.ProcessMessages;
until not bReading;
serialPort.SetTimerTrigger(TimerHandle, 256, True);
bReading := True; fESPMode := ESP300_COMMAND;
serialPort.PutString('3SN3' + Chr(13));
repeat
Application.ProcessMessages;
until not bReading;
serialPort.SetTimerTrigger(TimerHandle, 256, True);
bReading := True; fESPMode := ESP300_COMMAND;
serialPort.PutString('1SU0.2' + Chr(13));
repeat
Application.ProcessMessages;
until not bReading;
serialPort.SetTimerTrigger(TimerHandle, 256, True);
bReading := True; fESPMode := ESP300_COMMAND;
serialPort.PutString('2SU0.2' + Chr(13));
repeat
Application.ProcessMessages;
until not bReading;
serialPort.SetTimerTrigger(TimerHandle, 256, True);
bReading := True; fESPMode := ESP300_COMMAND;
serialPort.PutString('3SU0.2' + Chr(13));
repeat
Application.ProcessMessages;
until not bReading;
{Let's get the max velocities for each axis}
serialPort.SetTimerTrigger(TimerHandle, 256, True);
bReading := True; fEspMode := ESP300_READING_X;
serialPort.PutString('1VU?' + Chr(13));
repeat
Application.ProcessMessages;
until not bReading;
if not bMovingError then maxVelocityX := lastX;
serialPort.SetTimerTrigger(TimerHandle, 256, True);
bReading := True; fEspMode := ESP300_READING_Y;
serialPort.PutString('2VU?' + Chr(13));
repeat
Application.ProcessMessages;
until not bReading;
if not bMovingError then maxVelocityY := lastY;
serialPort.SetTimerTrigger(TimerHandle, 256, True);
bReading := True; fEspMode := ESP300_READING_Z;
serialPort.PutString('3VU?' + Chr(13));
repeat
Application.ProcessMessages;
until not bReading;
if not bMovingError then maxVelocityZ := lastZ;
fDeviceState := dsDetected;
except
fDeviceState := dsNotFound;
end;
except
fDeviceState := dsNotFound;
end;
end;
procedure TXYZESP300.SetZSpeed(speedIndex: integer);
begin
if fBusy then Exit;
bMovingError := False;
fESPMode := ESP300_COMMAND;
serialPort.SetTimerTrigger(TimerHandle, 256, True);
serialPort.PutString('3VA' + Format('%.1f', [speedIndex * maxVelocityZ / 20]) + Chr(13));
repeat
Application.ProcessMessages;
until not bReading;
end;
procedure TXYZESP300.SetXYSpeed(speedIndex: integer);
begin
if fBusy then Exit;
bMovingError := False;
fESPMode := ESP300_COMMAND;
serialPort.SetTimerTrigger(TimerHandle, 256, True);
serialPort.PutString('1VA' + Format('%.1f', [speedIndex * maxVelocityX / 20]) + Chr(13));
repeat
Application.ProcessMessages;
until not bReading;
fESPMode := ESP300_COMMAND;
serialPort.SetTimerTrigger(TimerHandle, 256, True);
serialPort.PutString('2VA' + Format('%.1f', [speedIndex * maxVelocityY / 20]) + Chr(13));
repeat
Application.ProcessMessages;
until not bReading;
end;
procedure TXYZESP300.GetZ(var newZ: double);
begin
if fBusy then Exit;
bMovingError := False;
bReading := True;
fESPMode := ESP300_READING_Z;
serialPort.SetTimerTrigger(TimerHandle, 256, True);
serialPort.PutString('3TP' + Chr(13));
repeat
Application.ProcessMessages;
until not bReading;
fESPMode := ESP300_READY;
ZStepper.fZPosition := lastZ;
end;
procedure TXYZESP300.MoveToRelativeZ(newDeltaZ: double);
begin
if fBusy then Exit;
bMovingError := False;
fBusy := True;
zStepper.OnMoveStarted;
fESPMode := ESP300_COMMAND;
serialPort.SetTimerTrigger(TimerHandle, 256, True);
serialPort.PutString('3PR' + Format('%.1f', [newDeltaZ]) + Chr(13));
fESPMode := ESP300_COMMAND;
serialPort.PutString('3WS0');
bReading := True;
fESPMode := ESP300_READING_Z;
serialPort.PutString('3TP' + Chr(13));
repeat
Application.ProcessMessages;
until not bReading;
fESPMode := ESP300_READY;
ZStepper.fZPosition := lastZ;
zStepper.OnMoveFinished;
fBusy := False;
end;
procedure TXYZESP300.SetZ(var newZ: double);
begin
if fBusy then Exit;
bMovingError := False;
fBusy := True;
zStepper.OnMoveStarted;
fESPMode := ESP300_COMMAND;
serialPort.SetTimerTrigger(TimerHandle, 256, True);
serialPort.PutString('3PA' + Format('%.1f', [newZ]) + Chr(13));
fESPMode := ESP300_COMMAND;
serialPort.PutString('3WS0');
bReading := True;
fESPMode := ESP300_READING_Z;
serialPort.PutString('3TP' + Chr(13));
repeat
Application.ProcessMessages;
until not bReading;
fESPMode := ESP300_READY;
ZStepper.fZPosition := lastZ;
fBusy := False;
end;
procedure TXYZESP300.MoveToZ(newZ: double);
begin
if fBusy then Exit;
bMovingError := False;
fBusy := True;
fESPMode := ESP300_COMMAND;
serialPort.SetTimerTrigger(TimerHandle, 256, True);
serialPort.PutString('3PA' + Format('%.1f', [newZ]) + Chr(13));
fESPMode := ESP300_COMMAND;
serialPort.PutString('3WS0');
bReading := True;
fESPMode := ESP300_READING_Z;
serialPort.PutString('3TP' + Chr(13));
repeat
Application.ProcessMessages;
until not bReading;
fESPMode := ESP300_READY;
ZStepper.fZPosition := lastZ;
ZStepper.OnMoveFinished;
fBusy := False;
end;
function TXYZESP300.ReadZ: double;
begin
if fBusy then
Result := 0
else
begin
bMovingError := False;
bReading := True;
fESPMode := ESP300_READING_Z;
serialPort.SetTimerTrigger(TimerHandle, 256, True);
serialPort.PutString('3TP' + Chr(13));
repeat
Application.ProcessMessages;
until not bReading;
fESPMode := ESP300_READY;
ZStepper.fZPosition := lastZ;
Result := lastZ;
end;
end;
procedure TXYZESP300.ShiftByZ(deltaZ: double);
begin
if fBusy then Exit;
bMovingError := False;
fBusy := True;
serialPort.SetTimerTrigger(TimerHandle, 256, True);
fESPMode := ESP300_COMMAND;
serialPort.PutString('3PR' + Format('%.1f', [deltaZ]) + Chr(13));
fESPMode := ESP300_COMMAND;
serialPort.PutString('3WS0');
bReading := True;
fESPMode := ESP300_READING_Z;
serialPort.SetTimerTrigger(TimerHandle, 256, True);
serialPort.PutString('3TP' + Chr(13));
repeat
Application.ProcessMessages;
until not bReading;
fESPMode := ESP300_READY;
ZStepper.fZPosition := lastZ;
ZStepper.OnMoveFinished;
fBusy := False;
end;
procedure TXYZESP300.GetXY(var newX, newY: integer);
begin
if fBusy then Exit;
bMovingError := False;
bReading := True;
fESPMode := ESP300_READING_X;
serialPort.SetTimerTrigger(TimerHandle, 256, True);
serialPort.PutString('1TP' + Chr(13));
repeat
Application.ProcessMessages;
until not bReading;
fESPMode := ESP300_READY;
XYTable.fXPosition := Round(lastX);
bReading := True;
fESPMode := ESP300_READING_Y;
serialPort.SetTimerTrigger(TimerHandle, 256, True);
serialPort.PutString('2TP' + Chr(13));
repeat
Application.ProcessMessages;
until not bReading;
fESPMode := ESP300_READY;
XYTable.fYPosition := Round(lastY);
end;
procedure TXYZESP300.SetXY(var newX, newY: integer);
begin
if fBusy then Exit;
bMovingError := False;
fBusy := True;
serialPort.SetTimerTrigger(TimerHandle, 256, True);
fESPMode := ESP300_COMMAND;
serialPort.PutString('1PA' + IntToStr(newX) + Chr(13));
fESPMode := ESP300_COMMAND;
serialPort.PutString('2PA' + IntToStr(newY) + Chr(13));
fESPMode := ESP300_COMMAND;
serialPort.PutString('1WS0');
fESPMode := ESP300_COMMAND;
serialPort.PutString('2WS0');
bReading := True;
fESPMode := ESP300_READING_X;
serialPort.PutString('1TP' + Chr(13));
repeat
Application.ProcessMessages;
until not bReading;
fESPMode := ESP300_READY;
XYTable.fXPosition := Round(lastX);
bReading := True;
fESPMode := ESP300_READING_Y;
serialPort.SetTimerTrigger(TimerHandle, 256, True);
serialPort.PutString('2TP' + Chr(13));
repeat
Application.ProcessMessages;
until not bReading;
fESPMode := ESP300_READY;
XYTable.fYPosition := Round(lastY);
XYTable.OnMoveFinished;
fBusy := False;
end;
procedure TXYZESP300.SetRelativeXY(deltaX, deltaY: integer);
begin
if fBusy then Exit;
bMovingError := False;
xyTable.OnMoveStarted;
fBusy := True;
serialPort.SetTimerTrigger(TimerHandle, 256, True);
fESPMode := ESP300_COMMAND;
serialPort.PutString('1PR' + IntToStr(deltaX) + Chr(13));
fESPMode := ESP300_COMMAND;
serialPort.PutString('2PR' + IntToStr(deltaY) + Chr(13));
fESPMode := ESP300_COMMAND;
serialPort.PutString('1WS0');
fESPMode := ESP300_COMMAND;
serialPort.PutString('2WS0');
bReading := True;
fESPMode := ESP300_READING_X;
serialPort.PutString('1TP' + Chr(13));
repeat
Application.ProcessMessages;
until not bReading;
fESPMode := ESP300_READY;
XYTable.fXPosition := Round(lastX);
bReading := True;
fESPMode := ESP300_READING_Y;
serialPort.SetTimerTrigger(TimerHandle, 256, True);
serialPort.PutString('2TP' + Chr(13));
repeat
Application.ProcessMessages;
until not bReading;
fESPMode := ESP300_READY;
XYTable.fYPosition := Round(lastY);
XYTable.OnMoveFinished;
fBusy := False;
end;
procedure TXYZESP300.MoveToXY(newX, newY: integer);
begin
if fBusy then Exit;
bMovingError := False;
fBusy := True;
serialPort.SetTimerTrigger(TimerHandle, 256, True);
serialPort.PutString('1PA' + IntToStr(newX) + Chr(13));
serialPort.PutString('2PA' + IntToStr(newY) + Chr(13));
serialPort.PutString('1WS0');
serialPort.PutString('2WS0');
bReading := True;
fESPMode := ESP300_READING_X;
serialPort.PutString('1TP' + Chr(13));
repeat
Application.ProcessMessages;
until not bReading;
fESPMode := ESP300_READY;
XYTable.fXPosition := Round(lastX);
bReading := True;
fESPMode := ESP300_READING_Y;
serialPort.SetTimerTrigger(TimerHandle, 256, True);
serialPort.PutString('2TP' + Chr(13));
repeat
Application.ProcessMessages;
until not bReading;
fESPMode := ESP300_READY;
XYTable.fYPosition := Round(lastY);
XYTable.OnMoveFinished;
fBusy := False;
end;
procedure TXYZESP300.ReadXY(var x, y: integer);
begin
if fBusy then Exit;
bMovingError := False;
bReading := True;
fESPMode := ESP300_READING_X;
serialPort.SetTimerTrigger(TimerHandle, 256, True);
serialPort.PutString('1TP' + Chr(13));
repeat
Application.ProcessMessages;
until not bReading;
fESPMode := ESP300_READY;
XYTable.fXPosition := Round(lastX);
bReading := True;
fESPMode := ESP300_READING_Y;
serialPort.SetTimerTrigger(TimerHandle, 256, True);
serialPort.PutString('2TP' + Chr(13));
repeat
Application.ProcessMessages;
until not bReading;
fESPMode := ESP300_READY;
XYTable.fYPosition := Round(lastY);
x := Round(lastX); y := Round(lastY);
end;
procedure TXYZESP300.ShiftByXY(deltaX, deltaY: integer);
begin
if fBusy then Exit;
bMovingError := False;
fBusy := True;
serialPort.SetTimerTrigger(TimerHandle, 256, True);
fESPMode := ESP300_COMMAND;
serialPort.PutString('1PR' + IntToStr(deltaX) + Chr(13));
fESPMode := ESP300_COMMAND;
serialPort.PutString('2PR' + IntToStr(deltaY) + Chr(13));
fESPMode := ESP300_COMMAND;
serialPort.PutString('1WS0');
fESPMode := ESP300_COMMAND;
serialPort.PutString('2WS0');
bReading := True;
fESPMode := ESP300_READING_X;
serialPort.PutString('1TP' + Chr(13));
repeat
Application.ProcessMessages;
until not bReading;
fESPMode := ESP300_READY;
XYTable.fXPosition := Round(lastX);
bReading := True;
fESPMode := ESP300_READING_Y;
serialPort.SetTimerTrigger(TimerHandle, 256, True);
serialPort.PutString('2TP' + Chr(13));
repeat
Application.ProcessMessages;
until not bReading;
fESPMode := ESP300_READY;
XYTable.fYPosition := Round(lastY);
XYTable.OnMoveFinished;
fBusy := False;
end;
procedure TXYZESP300.XYCommand(const sCommand: string);
begin
if fESPMode <> ESP300_READY then Exit;
bReading := True;
fESPMode := ESP300_COMMAND;
serialPort.SetTimerTrigger(TimerHandle, 256, True);
serialPort.PutString(sCommand + Chr(13));
repeat
Application.ProcessMessages;
until not bReading;
fESPMode := ESP300_READY;
end;
constructor TXYZESP300.Create;
begin
inherited Create;
serialPort := TApdCOMPort.Create(nil);
serialPort.AutoOpen := False;
end;
destructor TXYZESP300.Destroy;
begin
serialPort.Free;
inherited Destroy;
end;
{***************************** MICROMANIPULATOR *******************************}
procedure TMicromanipulator.FindDescentPosition(var descentPos: TMManPt);
var mmanTarget: TMManPt;
begin
XYZToManipulator(xyzTargetPt, mmanTarget);
{descent pos is startDescentDistance away from target, at angle approachAngle
in the X-Z or Y-Z plane}
if AxialIsXZ then
begin
descentPos[mmanX] := mmanTarget[mmanX] - cos(2*pi*approachAngle/360) * startDescentDistance;
descentPos[mmanY] := mmanTarget[mmanY];
end
else
begin
descentPos[mmanY] := mmanTarget[mmanY] - cos(2*pi*approachAngle/360) * startDescentDistance;
descentPos[mmanX] := mmanTarget[mmanX];
end;
descentPos[mmanZ] := mmanTarget[mmanZ] + sin(2*pi*approachAngle/360) * startDescentDistance;
end;
function TMicromanipulator.GetApproachAngle: double;
begin
Result := approachAngles[fmanIndex];
end;
function TMicromanipulator.GetApproachSpeed: integer;
begin
Result := approachSpeeds[fmanIndex];
end;
function TMicromanipulator.GetAxialIsXZ: boolean;
begin
Result := axialIsXZs[fmanIndex];
end;
function TMicromanipulator.GetCalibrationShift: integer;
begin
Result := calibrationShifts[fmanIndex];
end;
function TMicromanipulator.GetCoarseMotion: boolean;
begin
Result := True;
end;
function TMicromanipulator.GetCOMPort: integer;
begin
Result := mmCOMPortIndex[fmanIndex];
end;
function TMicromanipulator.GetCOMSpeed: integer;
begin
Result := mmCOMSpeedIndex[fmanIndex];
end;
function TMicromanipulator.GetContactSpeed: integer;
begin
Result := contactSpeeds[fmanIndex];
end;
function TMicromanipulator.GetContactStepSize: double;
begin
Result := contactStepSizes[fmanIndex];
end;
function TMicromanipulator.GetDescentSpeed: integer;
begin
Result := descentSpeeds[fmanIndex];
end;
function TMicromanipulator.GetInvertX: boolean;
begin
Result := bmmInvertX[fmanIndex];
end;
function TMicromanipulator.GetInvertY: boolean;
begin
Result := bmmInvertY[fmanIndex];
end;
function TMicromanipulator.GetInvertZ: boolean;
begin
Result := bmmInvertZ[fmanIndex];
end;
function TMicromanipulator.GetmmReadDelay: integer;
begin
Result := fmmReadDelay;
end;
function TMicromanipulator.GetFirstMotionType: TMManCoordinates;
begin
Result := firstMotionTypes[fmanIndex];
end;
function TMicromanipulator.GetSecondMotionType: TMManCoordinates;
begin
Result := secondMotionTypes[fmanIndex];
end;
function TMicromanipulator.GetThirdMotionType: TMManCoordinates;
begin
Result := thirdMotionTypes[fmanIndex];
end;
function TMicromanipulator.GetstartDescentDistance: double;
begin
Result := startDescentDistances[fmanIndex];
end;
function TMicromanipulator.GetstopDescentDistance: double;
begin
Result := stopDescentDistances[fmanIndex];
end;
function TMicromanipulator.GetxyzReadDelay: integer;
begin
Result := fxyzReadDelay;
end;
procedure TMicromanipulator.SetApproachAngle(value: double);
begin
if (value > 0) and (value < 90) then
approachAngles[fmanIndex] := value;
end;
procedure TMicromanipulator.SetApproachSpeed(value: integer);
begin
if (value > 0) and (value <= 2900) then
approachSpeeds[fmanIndex] := value;
end;
procedure TMicromanipulator.SetAxialIsXZ(value: boolean);
begin
axialIsXZs[fmanIndex] := value;
end;
procedure TMicromanipulator.SetCalibrationShift(value: integer);
begin
calibrationShifts[fmanIndex] := value;
end;
procedure TMicromanipulator.SetCoarseMotion(value: boolean);
begin
end;
procedure TMicromanipulator.SetCOMPort(value: integer);
begin
mmCOMPortIndex[fmanIndex] := value;
end;
procedure TMicromanipulator.SetCOMSpeed(value: integer);
begin
mmCOMSpeedIndex[fmanIndex] := value;
end;
procedure TMicromanipulator.SetContactSpeed(value: integer);
begin
contactSpeeds[fmanIndex] := value;
end;
procedure TMicromanipulator.SetContactStepSize(value: double);
begin
contactStepSizes[fmanIndex] := value;
end;
procedure TMicromanipulator.SetDescentSpeed(value: integer);
begin
descentSpeeds[fmanIndex] := value;
end;
procedure TMicromanipulator.SetInvertX(value: boolean);
begin
bmmInvertX[fmanIndex] := value;
end;
procedure TMicromanipulator.SetInvertY(value: boolean);
begin
bmmInvertY[fmanIndex] := value;
end;
procedure TMicromanipulator.SetInvertZ(value: boolean);
begin
bmmInvertZ[fmanIndex] := value;
end;
procedure TMicromanipulator.SetmmReadDelay(value: integer);
begin
fmmReadDelay := value;
end;
procedure TMicromanipulator.SetFirstMotionType(value: TMManCoordinates);
begin
firstMotionTypes[fmanIndex] := value;
end;
procedure TMicromanipulator.SetSecondMotionType(value: TMManCoordinates);
begin
secondMotionTypes[fmanIndex] := value;
end;
procedure TMicromanipulator.SetThirdMotionType(value: TMManCoordinates);
begin
thirdMotionTypes[fmanIndex] := value;
end;
procedure TMicromanipulator.SetxyzReadDelay(value: integer);
begin
fxyzReadDelay := value;
end;
procedure TMicromanipulator.SetstartDescentDistance(value: double);
begin
startDescentDistances[fmanIndex] := value;
end;
procedure TMicromanipulator.SetstopDescentDistance(value: double);
begin
stopDescentDistances[fmanIndex] := value;
end;
procedure TMicromanipulator.XYZToManipulator(xyzPt: TXYZPt; var manPt: TMManPt);
var vector: TXYZPt;
begin
vector[mmanX] := xyzPt[mmanX] - xyzCalibrationPts[0][mmanX];
vector[mmanY] := xyzPt[mmanY] - xyzCalibrationPts[0][mmanY];
vector[mmanZ] := xyzPt[mmanZ] - xyzCalibrationPts[0][mmanZ];
{rotates vector}
manPt[mmanX] := calibMatrix[0,0] * vector[mmanX] + calibMatrix[1,0] * vector[mmanY] + calibMatrix[2,0] * vector[mmanZ];
manPt[mmanY] := calibMatrix[0,1] * vector[mmanX] + calibMatrix[1,1] * vector[mmanY] + calibMatrix[2,1] * vector[mmanZ];
manPt[mmanZ] := calibMatrix[0,2] * vector[mmanX] + calibMatrix[1,2] * vector[mmanY] + calibMatrix[2,2] * vector[mmanZ];
{changes origin}
manPt[mmanX] := manPt[mmanX] + mmanCalibrationPts[0][mmanX];
manPt[mmanY] := manPt[mmanY] + mmanCalibrationPts[0][mmanY];
manPt[mmanZ] := manPt[mmanZ] + mmanCalibrationPts[0][mmanZ];
end;
procedure TMicromanipulator.Calibrate;
var deltas: array[1..3] of TXYZPt;
i: integer;
j: TMManCoordinates;
aXY23, aXZ21, aXY21, aXZ23, delta: double;
begin
for i := 1 to 3 do
for j := mmanX to mmanZ do
deltas[i, j] := xyzCalibrationPts[i, j] - xyzCalibrationPts[0, j];
aXY23 := deltas[2][mmanX] * deltas[3][mmanY] - deltas[3][mmanX] * deltas[2][mmanY];
aXZ21 := deltas[2][mmanX] * deltas[1][mmanZ] - deltas[1][mmanX] * deltas[2][mmanZ];
aXY21 := deltas[2][mmanX] * deltas[1][mmanY] - deltas[1][mmanX] * deltas[2][mmanY];
aXZ23 := deltas[2][mmanX] * deltas[3][mmanZ] - deltas[3][mmanX] * deltas[2][mmanZ];
delta := aXZ21 * aXY23 - aXZ23 * aXY21;
calibMatrix[2,0] := aXY23 * calibrationShift * deltas[2][mmanX] / delta;
calibMatrix[1,0] := (calibrationShift * deltas[2][mmanX] - aXZ21 * calibMatrix[2,0]) / aXY21;
calibMatrix[0,0] := (calibrationShift - calibMatrix[1,0] * deltas[1][mmanY] - calibMatrix[2,0] * deltas[1][mmanZ]) / deltas[1][mmanX];
calibMatrix[2,1] := - aXY21 * calibrationShift * deltas[3][mmanX] / delta;
calibMatrix[1,1] := - aXZ21 * calibMatrix[2,1] / aXY21;
calibMatrix[0,1] := - (calibMatrix[1,1] * deltas[1][mmanY] + calibMatrix[2,1] * deltas[1][mmanZ]) / deltas[1][mmanX];
calibMatrix[2,2] := - aXY21 * calibrationShift * deltas[2][mmanX] / delta;
calibMatrix[1,2] := - aXZ21 * calibMatrix[2,2] / aXY21;
calibMatrix[0,2] := - (calibMatrix[1,2] * deltas[1][mmanY] + calibMatrix[2,2] * deltas[1][mmanZ]) / deltas[1][mmanX];
if Phase = mpTargeted then Phase := mpTargeted_Calibrated else
Phase := mpCalibrated;
end;
procedure TMicromanipulator.ContactMoveDown(bDown: boolean);
var targetPos, vector, nextPos: TMManPt;
distance: double;
begin
{We move towards or away from the target in the X-Y-Z axis from our current position
by contactStepSize increment}
GetCurrentMMPosition;
XYZToManipulator(xyzTargetPt, targetPos);
distance := FindDistance(currentPos, targetPos);
if (distance < 0.01) and bDown then Exit; {0.01 microns minimal distance: bail!}
vector[mmanX] := contactStepSize * (targetPos[mmanX] - currentPos[mmanX]) / distance;
vector[mmanY] := contactStepSize * (targetPos[mmanY] - currentPos[mmanY]) / distance;
vector[mmanZ] := contactStepSize * (targetPos[mmanX] - currentPos[mmanZ]) / distance;
if bDown then
begin
nextPos[mmanX] := currentPos[mmanX] + vector[mmanX];
nextPos[mmanY] := currentPos[mmanY] + vector[mmanY];
nextPos[mmanZ] := currentPos[mmanZ] + vector[mmanZ];
end
else
begin
nextPos[mmanX] := currentPos[mmanX] - vector[mmanX];
nextPos[mmanY] := currentPos[mmanY] - vector[mmanY];
nextPos[mmanZ] := currentPos[mmanZ] - vector[mmanZ];
end;
MoveAndWait(nextPos);
end;
procedure TMicromanipulator.GetCurrentMMPosition;
begin
GetXYZ;
repeat
Application.ProcessMessages;
until mmanOp = mmanOK;
end;
procedure TMicromanipulator.GoHome;
var nextPos, newPos: TMManPt;
begin
{3rd motion}
GetCurrentMMPosition;
if thirdMotionType = mmanX then
begin
nextPos[mmanX] := homePt[mmanX];
nextPos[mmanY] := currentPos[mmanY];
nextPos[mmanZ] := currentPos[mmanZ];
end
else if thirdMotionType = mmanY then
begin
nextPos[mmanX] := currentPos[mmanX];
nextPos[mmanY] := homePt[mmanY];
nextPos[mmanZ] := currentPos[mmanZ];
end
else
begin
nextPos[mmanX] := currentPos[mmanX];
nextPos[mmanY] := currentPos[mmanY];
nextPos[mmanZ] := homePt[mmanZ];
end;
MoveAndWait(nextPos);
newPos := currentPos;
{2nd motion}
if secondMotionType = mmanX then
begin
nextPos[mmanX] := homePt[mmanX];
nextPos[mmanY] := newPos[mmanY];
nextPos[mmanZ] := newPos[mmanZ];
end
else if secondMotionType = mmanY then
begin
nextPos[mmanX] := newPos[mmanX];
nextPos[mmanY] := homePt[mmanY];
nextPos[mmanZ] := newPos[mmanZ];
end
else
begin
nextPos[mmanX] := newPos[mmanX];
nextPos[mmanY] := newPos[mmanY];
nextPos[mmanZ] := homePt[mmanZ];
end;
MoveAndWait(nextPos);
newPos := currentPos;
{1st motion}
if firstMotionType = mmanX then
begin
nextPos[mmanX] := homePt[mmanX];
nextPos[mmanY] := newPos[mmanY];
nextPos[mmanZ] := newPos[mmanZ];
end
else if firstMotionType = mmanY then
begin
nextPos[mmanX] := newPos[mmanX];
nextPos[mmanY] := homePt[mmanY];
nextPos[mmanZ] := newPos[mmanZ];
end
else
begin
nextPos[mmanX] := newPos[mmanX];
nextPos[mmanY] := newPos[mmanY];
nextPos[mmanZ] := homePt[mmanZ];
end;
MoveAndWait(nextPos);
end;
procedure TMicromanipulator.GotoDescentPos;
var mmanDescentPos: TMManPt;
begin
FindDescentPosition(mmanDescentPos);
GetCurrentMMPosition;
if (currentPos[mmanX] <> mmanDescentPos[mmanX]) or
(currentPos[mmanY] <> mmanDescentPos[mmanY]) or
(currentPos[mmanZ] <> mmanDescentPos[mmanZ])
then
MoveAndWait(mmanDescentPos);
end;
procedure TMicromanipulator.GetXYZ;
begin
end;
procedure TMicromanipulator.MoveToXYZ(newX, newY, newZ: double);
begin
end;
procedure TMicromanipulator.MoveRelative(deltaX, deltaY, deltaZ: double);
var manPt: TMManPt;
begin
GetCurrentMMPosition;
if InvertX then deltaX := - deltaX;
if InvertY then deltaY := - deltaY;
if InvertZ then deltaZ := - deltaZ;
manPt[mmanX] := currentPos[mmanX] + deltaX;
manPt[mmanY] := currentPos[mmanY] + deltaY;
manPt[mmanZ] := currentPos[mmanZ] + deltaZ;
MoveAndWait(manPt);
end;
procedure TMicromanipulator.SetSpeed(value: integer);
begin
fSpeed := value;
end;
procedure TMicromanipulator.MoveAndWait(manPt: TMManPt);
var i: integer;
begin
with Mainform do
begin
Screen.Cursor := crHourGlass;
Shape5.Brush.Color := clRed;
Shape5.Refresh;
end;
MoveToXYZ(manPt[mmanX], manPt[mmanY], manPt[mmanZ]);
repeat
Application.ProcessMessages;
until mmanOp = mmanOK;
with Mainform do
begin
Shape5.Brush.Color := clLime;
Shape5.Refresh;
{MP-285 is a slow device - this loop adds a delay after a move}
for i := 1 to mmReadDelay do Application.ProcessMessages;
GetCurrentMMPosition;
UpdateMManCaptions;
Screen.Cursor := crDefault;
end;
end;
procedure TMicromanipulator.StartApproach;
var mmanDescentPos, nextPos: TMManPt;
begin
FindDescentPosition(mmanDescentPos);
{1st motion}
GetCurrentMMPosition;
if firstMotionType = mmanX then
begin
nextPos[mmanX] := mmanDescentPos[mmanX];
nextPos[mmanY] := currentPos[mmanY];
nextPos[mmanZ] := currentPos[mmanZ];
end
else if firstMotionType = mmanY then
begin
nextPos[mmanX] := currentPos[mmanX];
nextPos[mmanY] := mmanDescentPos[mmanY];
nextPos[mmanZ] := currentPos[mmanZ];
end
else
begin
nextPos[mmanX] := currentPos[mmanX];
nextPos[mmanY] := currentPos[mmanY];
nextPos[mmanZ] := mmanDescentPos[mmanZ];
end;
MoveAndWait(nextPos);
{2nd motion}
if secondMotionType = mmanX then
begin
nextPos[mmanX] := mmanDescentPos[mmanX];
nextPos[mmanY] := currentPos[mmanY];
nextPos[mmanZ] := currentPos[mmanZ];
end
else if secondMotionType = mmanY then
begin
nextPos[mmanX] := currentPos[mmanX];
nextPos[mmanY] := mmanDescentPos[mmanY];
nextPos[mmanZ] := currentPos[mmanZ];
end
else
begin
nextPos[mmanX] := currentPos[mmanX];
nextPos[mmanY] := currentPos[mmanY];
nextPos[mmanZ] := mmanDescentPos[mmanZ];
end;
MoveAndWait(nextPos);
{3rd motion}
if thirdMotionType = mmanX then
begin
nextPos[mmanX] := mmanDescentPos[mmanX];
nextPos[mmanY] := currentPos[mmanY];
nextPos[mmanZ] := currentPos[mmanZ];
end
else if thirdMotionType = mmanY then
begin
nextPos[mmanX] := currentPos[mmanX];
nextPos[mmanY] := mmanDescentPos[mmanY];
nextPos[mmanZ] := currentPos[mmanZ];
end
else
begin
nextPos[mmanX] := currentPos[mmanX];
nextPos[mmanY] := currentPos[mmanY];
nextPos[mmanZ] := mmanDescentPos[mmanZ];
end;
MoveAndWait(nextPos);
end;
procedure TMicromanipulator.StartDescent;
var targetPos, vector, nextPos: TMManPt;
distance, newdistance: double;
begin
GotoDescentPos; {just to be on the safe side - we will be StartDescentDistance
away from targe}
GetCurrentMMPosition;
XYZToManipulator(xyzTargetPt, targetPos);
distance := FindDistance(currentPos, targetPos); {StartDescentDistance}
newdistance := distance - stopDescentDistance;
if newdistance < distance then
begin
vector[mmanX] := newdistance * (targetPos[mmanX] - currentPos[mmanX]) / distance;
vector[mmanY] := newdistance * (targetPos[mmanY] - currentPos[mmanY]) / distance;
vector[mmanZ] := newdistance * (targetPos[mmanX] - currentPos[mmanZ]) / distance;
nextPos[mmanX] := currentPos[mmanX] + vector[mmanX];
nextPos[mmanY] := currentPos[mmanY] + vector[mmanY];
nextPos[mmanZ] := currentPos[mmanZ] + vector[mmanZ];
MoveAndWait(nextPos);
end;
end;
constructor TMicromanipulator.CreateManip(index: integer);
begin
fmanIndex := index;
name := 'Micromanipulator ' + IntToStr(index) + ': ';
end;
{*********************************** MP-285 ***********************************}
//
// Resolution of MP-285 is 5 microsteps /microns => 0.2 um / step by default
//
function TMP285.GetCoarseMotion: boolean;
begin
Result := (microstepsPerMicron = 5);
end;
procedure TMP285.SetCoarseMotion(value: boolean);
begin
if value then microstepsPerMicron := 5 else microstepsPerMicron := 25;
SetSpeed(fSpeed);
UpdateMP285Display;
end;
{procedure TMP285.GetResolution;
var MP285Config: TMP285Config;
begin
mmanOp := mmanGetResolution;
sserial := '';
serialPort.PutString('s' + Chr(13));
repeat
Application.ProcessMessages;
until mmanOp = mmanOK;
Move(sserial[1], MP285Config, SizeOf(MP285Config));
if MP285Config.step_div > 32767 then high-order bit of step_div is set
microstepsPerMicron := 25
else
microstepsPerMicron := 5;
end;}
procedure TMP285.Connect;
begin
inherited Connect;
try
with serialPort do
begin
Baud := COMSpeed;
COMNumber := COMPort;
Parity := pNone;
DataBits := 8;
StopBits := 1;
sSerial := '';
serialPort.Open := True;
CRTriggerHandle := AddDataTrigger(Chr(13), False);
TimerHandle := AddTimerTrigger;
OnTriggerData := TriggerData;
OnTriggerAvail := TriggerAvail;
OnTriggerTimer := TimerReceived;
end;
mmanOp := mmanOK;
try
fBusy := False;
fDeviceState := dsDetected;
SetSpeed(fSpeed);
except
fDeviceState := dsNotFound;
end;
except
fDeviceState := dsNotFound;
end;
end;
procedure TMP285.TriggerData(CP: TObject; TriggerHandle: Word);
var newPos: array[0..2] of integer;
begin
serialPort.SetTimerTrigger(TimerHandle, 256, False);
if TriggerHandle <> CRTriggerHandle then Exit;
if mmanOp = mmanOK then Exit; {because TriggerData is called for the last CR}
case mmanOp of
mmanGetPos:
begin
if Length(sserial) >= SizeOf(newPos) then
begin
{copy return string}
Move(sserial[1], newPos, SizeOf(newPos));
{convert microsteps into microns}
currentPos[mmanX] := newPos[0] / MICROSTEP_SIZE;
currentPos[mmanY] := newPos[1] / MICROSTEP_SIZE;
currentPos[mmanZ] := newPos[2] / MICROSTEP_SIZE;
end;
end;
end;
fBusy := False;
sSerial := '';
mmanOp := mmanOK;
end;
procedure TMP285.UpdateMP285Display;
begin
fBusy := True;
mmanOp := mmanUpdateDisplay;
sserial := '';
serialPort.SetTimerTrigger(TimerHandle, 256, True);
serialPort.PutString('n' + Chr(13));
repeat
Application.ProcessMessages;
until mmanOp = mmanOK;
end;
procedure TMP285.TriggerAvail(CP: TObject; Count: Word);
var i: Word;
begin
for i := 1 to Count do
sserial := sserial + serialPort.GetChar;
end;
procedure TMP285.TimerReceived(CP: TObject; TriggerHandle: Word);
begin
if TriggerHandle = TimerHandle then
begin
{time-out: we lost the device}
fDeviceState := dsNotFound;
// serialPort.RemoveTrigger(TriggerHandle);
mmanOp := mmanOK;
end;
end;
procedure TMP285.GetXYZ;
begin
inherited GetXYZ;
if mmanOp <> mmanOK then Exit;
fBusy := True;
sserial := '';
mmanOp := mmanGetPos;
serialPort.SetTimerTrigger(TimerHandle, 256, True);
{06-23-06; Sutter MP-285 serial port leaves garbage; this cleans it}
PurgeComm(serialPort.Dispatcher.Handle, PURGE_RXCLEAR);
serialPort.PutString('c' + Chr(13));
end;
procedure TMP285.MoveToXYZ(newX, newY, newZ: double);
var moverecord: TMP285MoveRec;
s: string;
begin
inherited MoveToXYZ(newX, newY, newZ);
if mmanOp <> mmanOK then Exit;
fBusy := True;
{converts microns to microsteps}
with moverecord do
begin
command := 'm';
x := Round(newX * MICROSTEP_SIZE); {one microstep = 0.04 microns}
y := Round(newY * MICROSTEP_SIZE);
z := Round(newZ * MICROSTEP_SIZE);
end;
SetLength(s, SizeOf(TMP285MoveRec));
Move(moverecord, s[1], SizeOf(TMP285MoveRec));
sserial := '';
mmanOp := mmanMove;
serialPort.SetTimerTrigger(TimerHandle, 256, True);
serialPort.PutString(s + Chr(13)); {go for it}
end;
constructor TMP285.CreateManip(index: integer);
begin
inherited CreateManip(index);
name := 'MP-285 #' + IntToStr(index);
serialPort := TApdCOMPort.Create(nil);
serialPort.AutoOpen := False;
microstepsPerMicron := 5; {start with Coarse}
fSpeed := 1500; {1500 microns /s}
end;
procedure TMP285.SetSpeed(value: integer);
var s: string;
speedRecord : TMP285SpeedRec;
begin
inherited SetSpeed(value);
fBusy := True;
if mmanOp <> mmanOK then Exit;
if microstepsPerMicron = 5 then
begin {low resolution}
if (value <= 1) then value := 1;
if (value > 2900) then value := 2900;
end
else
begin
{1310 ~ 32767 / microstepsPerMicron}
if (value <= 1) then value := 1;
if (value > 1310) then value := 1310;
value := value Or 32768; {high bit set}
end;
speedRecord.command := 'v';
speedRecord.speed := value;
SetLength(s, SizeOf(TMP285SpeedRec));
Move(speedRecord, s[1], SizeOf(TMP285SpeedRec));
mmanOp := mmanSetSpeed;
sserial := '';
serialPort.SetTimerTrigger(TimerHandle, 256, True);
serialPort.PutString(s + Chr(13));
repeat
Application.ProcessMessages;
until mmanOp = mmanOK;
end;
destructor TMP285.Destroy;
begin
serialPort.Free;
inherited Destroy;
end;
{****************************** LASER CONTROLS ********************************}
function TLaserControl.GetincA: double;
begin
Result := laserControlincA;
end;
function TLaserControl.GetincB: double;
begin
Result := laserControlincB;
end;
function TLaserControl.GetincC: double;
begin
Result := laserControlincC;
end;
function TLaserControl.GetincD: double;
begin
Result := laserControlincD;
end;
function TLaserControl.GetdecA: double;
begin
Result := laserControldecA;
end;
function TLaserControl.GetdecB: double;
begin
Result := laserControldecB;
end;
function TLaserControl.GetdecC: double;
begin
Result := laserControldecC;
end;
function TLaserControl.GetdecD: double;
begin
Result := laserControldecD;
end;
procedure TLaserControl.SetincA(value: double);
begin
laserControlincA := value;
end;
procedure TLaserControl.SetincB(value: double);
begin
laserControlincB := value;
end;
procedure TLaserControl.SetincC(value: double);
begin
laserControlincC := value;
end;
procedure TLaserControl.SetincD(value: double);
begin
laserControlincD := value;
end;
procedure TLaserControl.SetdecA(value: double);
begin
laserControldecA := value;
end;
procedure TLaserControl.SetdecB(value: double);
begin
laserControldecB := value;
end;
procedure TLaserControl.SetdecC(value: double);
begin
laserControldecC := value;
end;
procedure TLaserControl.SetdecD(value: double);
begin
laserControldecD := value;
end;
function TLaserControl.GetCOMPort: integer;
begin
Result := laserControlCOMPortIndex;
end;
function TLaserControl.GetCOMSpeed: integer;
begin
Result := laserControlCOMSpeedIndex;
end;
procedure TLaserControl.SetCOMPort(value: integer);
begin
laserControlCOMPortIndex := value;
end;
procedure TLaserControl.SetCOMSpeed(value: integer);
begin
laserControlCOMSpeedIndex := value;
end;
procedure TLaserControl.SetPower(newPower: double);
begin
if (newPower < 0) or (newPower > 100) then Exit;
fPower := newPower;
Mainform.OnNewPower;
end;
procedure TLaserControl.SetWavelength(newWavelength: integer);
begin
if (newWaveLength < 600) or (newWavelength > 1100) then Exit;
fWaveLength := newWavelength;
Mainform.OnNewWavelength;
end;
constructor TLaserControl.Create;
begin
fWavelength := 800;
fPower := 0;
name := 'No Laser Control';
autoObject := TMPAutoLaserControl.Create as IMPLaserControl;
Connect;
end;
destructor TLaserControl.Destroy;
begin
autoObject := nil;
inherited Destroy;
end;
procedure TKimZhangLaserControl.SetPower( newPower : double);
var counter1, counter2: integer;
argcos: double;
begin
inherited SetPower(newPower);
{Assuming: power >= 0 and <= 100
servo controlled by train pulse issued by GPCTR 0; timebase is 20 MHz = 50 ns
train pulse = 50 Hz = 20 ms = 400000; 1 ms = 20000 clock ticks @ 20 MHz}
if prevPower < newPower then
begin
argcos := (newPower/100 - incD)/incA;
if argcos < -1 then argcos := -1;
if argcos > 1 then argcos := 1;
counter1 := Round( 20000 * ( Arccos(argcos)- incC) / incB );
end
else
begin
argcos := (newPower/100 - decD)/decA;
if argcos < -1 then argcos := -1;
if argcos > 1 then argcos := 1;
counter1 := Round( 20000 * ( Arccos(argcos) - decC) / decB );
end;
prevPower := round (newPower);
if counter1 < 0 then counter1 := 0;
if counter1 > 400000 then counter1 := 400000;
counter2 := 400000 - counter1; {low period}
GPCTR_Control(multifunctionBoard.boardIndex, ND_COUNTER_1, ND_RESET);
GPCTR_Set_Application(multifunctionBoard.boardIndex, ND_COUNTER_1, ND_PULSE_TRAIN_GNR);
GPCTR_Change_Parameter(multifunctionBoard.boardIndex, ND_COUNTER_1, ND_GATE, ND_LOW);
GPCTR_Change_Parameter(multifunctionBoard.boardIndex, ND_COUNTER_1, ND_GATE_POLARITY, ND_HIGH_TO_LOW);
GPCTR_Change_Parameter(multifunctionBoard.boardIndex, ND_COUNTER_1, ND_SOURCE, ND_INTERNAL_20_MHZ);
GPCTR_Change_Parameter(multifunctionBoard.boardIndex, ND_COUNTER_1, ND_SOURCE_POLARITY, ND_LOW_TO_HIGH);
GPCTR_Change_Parameter(multifunctionBoard.boardIndex, ND_COUNTER_1, ND_COUNT_1, counter2);
GPCTR_Change_Parameter(multifunctionBoard.boardIndex, ND_COUNTER_1, ND_COUNT_2, counter1);
Select_Signal(multifunctionBoard.boardIndex, ND_GPCTR1_OUTPUT, ND_GPCTR1_OUTPUT, ND_LOW_TO_HIGH);
GPCTR_Control(multifunctionBoard.boardIndex, ND_COUNTER_1, ND_PROGRAM);
end;
procedure TKimZhangLaserControl.Connect;
begin
fDeviceState := dsDetected;
end;
constructor TKimZhangLaserControl.Create;
begin
inherited Create;
name := 'Kim and Zhang''s Laser Control';
end;
{*********************************** Z Piezo **********************************}
procedure TZPiezo.OnScanningStarts;
begin
end;
procedure TZPiezo.OnScanningEnds;
begin
end;
function TZPiezo.ValidateParams(fromZ, toZ, deltaZ: double): boolean;
begin
Result := True;
end;
procedure TZPiezo.Connect;
begin
fDeviceState := dsNotInstalled;
end;
constructor TZPiezo.Create;
begin
inherited Create;
fZPiezoRange := 100;
name := 'Z- piezo';
Connect;
end;
{********************************* MIPOS 100 **********************************}
{MIPOS 100 from PiezoJena: -100 microns displacement, 0..10V command maps to 0..100 microns}
procedure TMIPOS100.OnScanningStarts; {outputs a ramp}
var cPts, i: integer;
currentZ: double;
begin
if ((deviceStatus = dsInstalled) or (deviceStatus = dsDetected)) and Mainform.Configuration.PiezoEnableZMove then
with opticsOutputBoard, Mainform.Configuration do
if (PiezoIncrement <> 0) and (PiezoStartAtZ <> PiezoStopAtZ) then
begin
{find size of zPiezoValues array}
cPts := Abs(Round((PiezoStartAtZ - PiezoStopAtZ) / PiezoIncrement)) + 1;
{makes sure that cPts is a multiple of 2 (restriction of the PCI-6711)}
cPts := (cPts div 2) * 2;
SetLength(zPiezoValues, cPts);
{stuff values in zPiezoValues array}
currentZ := PiezoStartAtZ;
for i := 0 to cPts - 1 do
begin
{0.. -100 um => 0..10 V <=> 0..2047 digital values for a PCI-6711}
zPiezoValues[i] := Round(- currentZ * 2047 / fZPiezoRange);
currentZ := currentZ + PiezoIncrement;
end;
outputChannels[0] := zPiezoOutChannel;
WFM_Load(BoardIndex, 1 {one channel}, @outputChannels, pi16(@zPiezoValues[0]),
Length(zPiezoValues), REPEAT_INDEFINITELY, ENABLE_FIFO_MODE);
{Make sure that the analog output clock is on RTSI 0}
Select_Signal(BoardIndex, ND_OUT_UPDATE_CLOCK_TIMEBASE, ND_RTSI_0, ND_LOW_TO_HIGH);
{Start of data out is RTSI_1 - added 02/22/2008}
Select_Signal(BoardIndex, ND_OUT_START_TRIGGER, ND_RTSI_1, ND_LOW_TO_HIGH);
{find the clock; data out updated either every line scan or pixel}
if PiezoUpdateEveryLine then
WFM_ClockRate(BoardIndex, MPUnit.GROUP_1, UPDATE_CLOCK, EXT_TIMEBASE,
FullFrameWidth * PixelClock, MODE_0)
else
WFM_ClockRate(BoardIndex, MPUnit.GROUP_1, UPDATE_CLOCK, EXT_TIMEBASE,
FullFrameWidth * FrameHeight * PixelClock, MODE_0);
{starts waveform generation}
WFM_Group_Control(BoardIndex, 1, AO_START);
end;
end;
procedure TMIPOS100.OnScanningEnds; {at the end,put piezo back to original pos}
begin
if ((deviceStatus = dsInstalled) or (deviceStatus = dsDetected)) and Mainform.Configuration.PiezoEnableZMove then
with opticsOutputBoard, Mainform.Configuration do
begin
{stop analog output}
WFM_Group_Control(BoardIndex, 1, AO_CLEAR);
{piezo at original position}
AO_Write(BoardIndex, zPiezoOutChannel, Round(- PiezoStartAtZ * 2047 / fZPiezoRange));
end;
end;
function TMIPOS100.ValidateParams(fromZ, toZ, deltaZ: double): boolean;
begin
Result := True;
if (fromZ < -ZPiezoRange) or (fromZ > 0) or (toZ < -ZPiezoRange) or (toZ > 0) or (Abs(fromZ - toZ) > fZPiezoRange) or
(Abs(deltaZ) > fZPiezoRange) or (fromZ - toZ = 0) or (deltaZ = 0) then Result := False
else if Abs(Round((fromZ - toZ) / deltaZ) + 1) > opticsOutputBoard.FIFOSampleCount then
Result := False
else if ((fromZ <= toZ) and (deltaZ <= 0)) or ((fromZ >= deltaZ) and (deltaZ >= 0)) then
Result := False;
end;
procedure TMIPOS100.Connect;
begin
fDeviceState := opticsOutputBoard.deviceStatus;
end;
{********************************* PIFOC 725 **********************************}
constructor TMIPOS100.Create;
begin
inherited Create;
fZPiezoRange := 100;
name := '100 um range Z- piezo';
end;
{********************************* PIFOC 725 **********************************}
constructor TPIFOC725.Create;
begin
inherited Create;
fZPiezoRange := 400;
name := '400 um range Z- piezo';
end;
{******************************************************************************}
{* XPS controller *}
{******************************************************************************}
{********************************* TZ_XYZ *************************************}
function TZ_XPS.GetDeviceState: TDeviceState;
begin
Result := xps.DeviceStatus;
end;
procedure TZ_XPS.SetSpeed(speedIndex: integer);
begin
inherited SetSpeed(speedIndex);
if (speedIndex < 1) or (speedIndex > 20) then Exit;
xps.SetZSpeed(speedIndex);
end;
procedure TZ_XPS.Connect;
begin
end;
{asynchronous: GetZ, MoveToRelative, SetZ}
procedure TZ_XPS.GetZ(var newZ: double);
begin
xps.GetZ(newZ);
end;
procedure TZ_XPS.MoveToRelativeZ(newDeltaZ: double);
begin
inherited MoveToRelativeZ(newDeltaZ);
if InvertZ then newDeltaZ := - newDeltaZ;
xps.ShiftByZ(newDeltaZ);
end;
procedure TZ_XPS.SetZ(var newZ: double);
begin
inherited SetZ(newZ);
xps.SetZ(newZ);
end;
{synchronous calls: MoveToZ, ReadZ, ShiftByZ}
procedure TZ_XPS.MoveToZ(newZ: double);
begin
inherited MoveToZ(newZ);
xps.MoveToZ(newZ);
repeat
Application.ProcessMessages;
until not Busy;
end;
function TZ_XPS.ReadZ: double;
begin
Result := xps.ReadZ;
end;
procedure TZ_XPS.ShiftByZ(deltaZ: double);
begin
inherited ShiftByZ(deltaZ);
if InvertZ then deltaZ := - deltaZ;
xps.ShiftByZ(deltaZ);
repeat
Application.ProcessMessages;
until not Busy;
end;
function TZ_XPS.TravelTime(zTravel: integer; speedIndex: integer): double;
begin
if DeviceStatus = dsDetected then
Result := zTravel / XPSZSpeed(speedIndex)
else
Result := 0;
end;
procedure TZ_XPS.StartFastScan;
begin
inherited StartFastScan;
startFastScanPosition := ZPosition;
curFastRepeatCount := 0;
with Mainform.configuration do
if zDistance > 0 then
xps.StartFastStack(Mainform.Configuration.TravelSpeed, stepSize)
else
xps.StartFastStack(Mainform.Configuration.TravelSpeed, -stepSize);
end;
procedure TZ_XPS.StopFastScan;
begin
inherited StopFastScan;
{return to old speed}
xps.SetZSpeed(Speed);
end;
constructor TZ_XPS.Create;
begin
inherited Create;
name := 'Z- XPS controller';
fStepSize := 0.1; {assume 0.1 micron for the minimal step size}
end;
destructor TZ_XPS.Destroy;
begin
inherited Destroy;
end;
{********************************* TXY_XPS ************************************}
function TXY_XPS.GetDeviceState: TDeviceState;
begin
Result := xps.deviceStatus;
end;
procedure TXY_XPS.SetSpeed(value: integer);
begin
xps.SetXYSpeed(value);
end;
procedure TXY_XPS.Connect;
begin
xps.Connect;
end;
{asynchronous}
procedure TXY_XPS.GetXY(var newX, newY: integer);
begin
xps.GetXY(newX, newY);
end;
procedure TXY_XPS.SetXY(var newX, newY: integer);
begin
inherited SetXY(newX, newY);
xps.SetXY(newX, newY);
end;
procedure TXY_XPS.SetRelativeXY(deltaX, deltaY: integer);
begin
inherited SetRelativeXY(deltaX, deltaY);
if XYTable.InvertX then deltaX := -deltaX;
if XYTable.InvertY then deltaY := -deltaY;
xps.SetRelativeXY(deltaX, deltaY);
end;
{synchronous}
procedure TXY_XPS.MoveToXY(newX, newY: integer);
begin
inherited MoveToXY(newX, newY);
xps.MoveToXY(newX, newY);
repeat
Application.ProcessMessages;
until not XYTable.Busy;
end;
procedure TXY_XPS.ReadXY(var x, y: integer);
begin
xps.ReadXY(x, y);
end;
procedure TXY_XPS.ShiftByXY(deltaX, deltaY: integer);
begin
inherited ShiftByXY(deltaX, deltaY);
if XYTable.InvertX then deltaX := -deltaX;
if XYTable.InvertY then deltaY := -deltaY;
xps.ShiftByXY(deltaX, deltaY);
repeat
Application.ProcessMessages;
until not XYTable.Busy;
end;
procedure TXY_XPS.XYCommand(const sCommand: string);
begin
xps.XYCommand(sCommand);
end;
constructor TXY_XPS.Create;
begin
inherited Create;
name := 'XY- XPS controller';
xps := TXPS.Create;
end;
destructor TXY_XPS.Destroy;
begin
xps.Free;
inherited Destroy;
end;
{********************************* TXPS ************************************}
{Assume units are in mm}
procedure TXPS.SetXYSpeed(speedIndex: integer);
begin
if ZStepper.deviceStatus <> dsDetected then Exit;
if not (xyTable.Busy or zStepper.Busy) then
begin
xpsAction := xpsa_SET_XY_SPEED;
xpsParam1 := speedIndex;
ReleaseSemaphore(xpsSemaphore, 1, nil); {starts the thread}
end;
end;
procedure TXPS.SetZSpeed(speedIndex: integer);
begin
if ZStepper.deviceStatus <> dsDetected then Exit;
if not (xyTable.Busy or zStepper.Busy) then
begin
xpsAction := xpsa_SET_Z_SPEED;
xpsParam1 := speedIndex;
ReleaseSemaphore(xpsSemaphore, 1, nil); {starts the thread}
end;
end;
procedure TXPS.Connect;
begin
if not LoadXPSLibrary then
fDeviceState := dsNotFound
else
try
if ConnectToXPS then
fDeviceState := dsDetected
else
fDeviceState := dsNotFound;
except
fDeviceState := dsNotFound;
end;
end;
procedure TXPS.GetZ(var newZ: double);
begin
if ZStepper.deviceStatus <> dsDetected then Exit;
xpsAction := xpsa_GET_Z;
ReleaseSemaphore(xpsSemaphore, 1, nil); {starts the thread}
repeat
Application.ProcessMessages;
until not ZStepper.Busy;
newZ := zStepper.ZPosition;
end;
procedure TXPS.MoveToRelativeZ(newDeltaZ: double);
begin
if ZStepper.deviceStatus <> dsDetected then Exit;
if not (xyTable.Busy or zStepper.Busy) then
begin
xpsAction := xpsa_SET_TO_RELATIVE_Z;
xpsParam1 := newDeltaZ;
ReleaseSemaphore(xpsSemaphore, 1, nil); {starts the thread}
end;
end;
procedure TXPS.SetZ(var newZ: double);
begin
if ZStepper.deviceStatus <> dsDetected then Exit;
if not (xyTable.Busy or zStepper.Busy) then
begin
xpsAction := xpsa_SET_Z;
xpsParam1 := newZ;
ReleaseSemaphore(xpsSemaphore, 1, nil); {starts the thread}
end;
end;
procedure TXPS.MoveToZ(newZ: double);
begin
if ZStepper.deviceStatus <> dsDetected then Exit;
SetZ(newZ);
end;
function TXPS.ReadZ: double;
begin
if ZStepper.deviceStatus <> dsDetected then
Result := 0
else
begin
xpsAction := xpsa_READ_Z;
ReleaseSemaphore(xpsSemaphore, 1, nil); {starts the thread}
repeat
Application.ProcessMessages;
until not ZStepper.Busy;
Result := zStepper.ZPosition;
end;
end;
procedure TXPS.ShiftByZ(deltaZ: double);
begin
if ZStepper.deviceStatus <> dsDetected then Exit;
MoveToRelativeZ(deltaZ);
repeat
Application.ProcessMessages;
until not ZStepper.Busy;
end;
procedure TXPS.GetXY(var newX, newY: integer);
begin
newX := 0; newY := 0;
if ZStepper.deviceStatus <> dsDetected then Exit;
xpsAction := xpsa_GET_XY;
ReleaseSemaphore(xpsSemaphore, 1, nil); {starts the thread}
repeat
Application.ProcessMessages;
until not ZStepper.Busy;
newX := XYTable.XPosition;
newY := XYTable.YPosition;
end;
procedure TXPS.SetXY(var newX, newY: integer);
begin
if ZStepper.deviceStatus <> dsDetected then Exit;
if not (xyTable.Busy or zStepper.Busy) then
begin
xpsAction := xpsa_SET_XY;
xpsParam1 := newX;
xpsParam2 := newY;
ReleaseSemaphore(xpsSemaphore, 1, nil); {starts the thread}
end;
end;
procedure TXPS.SetRelativeXY(deltaX, deltaY: integer);
begin
if ZStepper.deviceStatus <> dsDetected then Exit;
if not (xyTable.Busy or zStepper.Busy) then
begin
xpsAction := xpsa_SET_TO_RELATIVE_XY;
xpsParam1 := deltaX;
xpsParam2 := deltaY;
ReleaseSemaphore(xpsSemaphore, 1, nil); {starts the thread}
end;
end;
procedure TXPS.FastStackCallback;
var bFinished: boolean;
newPower: integer;
currentDisplacement: double;
begin
bFinished := False;
with ZStepper do
if not Odd(curFastRepeatCount) and (Mainform.Configuration.zDistance < 0) then
fastStackInterval {in microns}:= - ZStepper.StepSize / 1000
else
fastStackInterval {in microns}:= ZStepper.StepSize / 1000;
{Adjust laser power here}
with Mainform.Configuration, Mainform.engine do
if IntensityControl <> IC_NO_CONTROL then
begin
currentDisplacement := - zStepper.startFastScanPosition + zStepper.fZPosition;
if IntensityControl = IC_LINEAR then
newPower := Round(currentDisplacement * (FinalIntensity - InitialIntensity)/AtZDistance + InitialIntensity)
// analogOutputBoard.AnalogOut(1, TrackBar3.Position/10);
else
begin
if InitialIntensity <= 0 then InitialIntensity := 1;
newPower := Round(InitialIntensity *exp(currentDisplacement * Ln(FinalIntensity/InitialIntensity) / AtZDistance));
end;
if Abs(newPower - LaserControl.Power) > 0 then
begin
analogOutputBoard.AnalogOut(1, newPower/10);
LaserControl.Power := newPower;
end;
end;
// analogOutputBoard.AnalogOut(1, LaserControl.Power/10);
with ZStepper do
if (ZPosition = startFastScanPosition + Mainform.Configuration.zDistance) or
(ZPosition = startFastScanPosition) then
begin
curFastRepeatCount := curFastRepeatCount + 1;
if curFastRepeatCount >= Mainform.Configuration.FastStackRepeatCount then
begin
bFinished := True;
PostMessage(Mainform.Handle, WM_FASTSTACK_ENDED, 0, 0);
end;
end;
if not bFinished then ReleaseSemaphore(xpsSemaphore, 1, nil);
end;
procedure TXPS.MoveToXY(newX, newY: integer);
begin
if ZStepper.deviceStatus <> dsDetected then Exit;
if not (xyTable.Busy or zStepper.Busy) then
begin
xpsAction := xpsa_MOVE_TO_XY;
xpsParam1 := newX;
xpsParam2 := newY;
ReleaseSemaphore(xpsSemaphore, 1, nil); {starts the thread}
end;
end;
procedure TXPS.ReadXY(var x, y: integer);
begin
x := 0; y := 0;
if ZStepper.deviceStatus <> dsDetected then Exit;
GetXY(x, y);
end;
procedure TXPS.ShiftByXY(deltaX, deltaY: integer);
begin
if ZStepper.deviceStatus <> dsDetected then Exit;
if not (xyTable.Busy or zStepper.Busy) then
begin
xpsAction := xpsa_SHIFT_BY_XY;
xpsParam1 := deltaX;
xpsParam2 := deltaY;
ReleaseSemaphore(xpsSemaphore, 1, nil); {starts the thread}
end;
end;
procedure TXPS.XYCommand(const sCommand: string);
begin
end;
procedure TXPS.StartFastStack(fsSpeed: integer; deltaZ: double);
begin
if ZStepper.deviceStatus <> dsDetected then Exit;
SetZSpeed(fsSpeed);
repeat
Application.ProcessMessages;
until not ZStepper.Busy;
xpsAction := xpsa_FAST_STACK;
fastStackInterval {in microns}:= deltaZ / 1000;
ReleaseSemaphore(xpsSemaphore, 1, nil); {starts the thread}
end;
constructor TXPS.Create;
begin
inherited Create;
{load the pointers to the functions with LoadLibrary}
xpsAction := xpsa_NO_ACTION;
xpsSemaphore := CreateSemaphore(nil, 0, 1, nil);
xpsThread := TXPSThread.Create(False);
end;
destructor TXPS.Destroy;
begin
xpsThread.Terminate;
CloseHandle(xpsSemaphore);
UnloadXPSLibrary;
inherited Destroy;
end;
{******************************************************************************}
{* Galil DMC-40 controller *}
{******************************************************************************}
{********************************* TZ_XYZ *************************************}
function TZ_DMC40.GetDeviceState: TDeviceState;
begin
Result := dmc40.DeviceStatus;
end;
procedure TZ_DMC40.Connect;
begin
end;
procedure TZ_DMC40.GetZ(var newZ: double);
begin
dmc40.GetZ(newZ);
end;
procedure TZ_DMC40.MoveToRelativeZ(newDeltaZ: double);
begin
//jdp - called when user clicks on move button
inherited MoveToRelativeZ(newDeltaZ);
if InvertZ then newDeltaZ := - newDeltaZ;
dmc40.ShiftByZ(newDeltaZ);
end;
procedure TZ_DMC40.SetZ(var newZ: double);
begin
inherited SetZ(newZ);
dmc40.SetZ(newZ);
end;
procedure TZ_DMC40.MoveToZ(newZ: double);
begin
inherited MoveToZ(newZ);
dmc40.MoveToZ(newZ);
repeat
Application.ProcessMessages;
until not Busy;
end;
function TZ_DMC40.ReadZ: double;
begin
Result := dmc40.ReadZ;
end;
procedure TZ_DMC40.ShiftByZ(deltaZ: double);
begin
inherited ShiftByZ(deltaZ);
if InvertZ then deltaZ := - deltaZ;
dmc40.ShiftByZ(deltaZ);
repeat
Application.ProcessMessages;
until not Busy;
end;
function TZ_DMC40.TravelTime(zTravel: integer; speedIndex: integer): double;
//Mainform.Configuration.TravelSpeed and speedIndex both read the value of the slider (1 to 60) // PB
begin
if DeviceStatus = dsDetected then
Result := round(zTravel / Mainform.Configuration.TravelSpeed * 1000)/1000 // PB
else
Result := 0;
end;
procedure TZ_DMC40.StartFastScan;
begin
inherited StartFastScan;
startFastScanPosition := ZPosition;
curFastRepeatCount := 0;
//messageBox(0,PAnsiChar(FloatToStr(stepSize)),'TZ_DMC40.StartFastScan',0); //PB
with Mainform.configuration do
if zDistance > 0 then
dmc40.StartFastStack(Mainform.Configuration.TravelSpeed, stepSize)
else
dmc40.StartFastStack(Mainform.Configuration.TravelSpeed, -stepSize);
end;
procedure TZ_DMC40.StopFastScan;
begin
inherited StopFastScan;
{return to old speed}
// dmc40.SetZSpeed(Speed);
end;
constructor TZ_DMC40.Create;
begin
inherited Create;
name := 'Z- Galil DMC-40 controller';
fStepSize := 5/16; {assume 0.3125 micron for the minimal step size} //STEP NEED TO CHANGE
end;
destructor TZ_DMC40.Destroy;
begin
inherited Destroy;
end;
{********************************* TXY_DMC40 ************************************}
function TXY_DMC40.GetDeviceState: TDeviceState;
begin
Result := dmc40.deviceStatus;
end;
procedure TXY_DMC40.Connect;
begin
dmc40.Connect;
end;
{asynchronous}
procedure TXY_DMC40.GetXY(var newX, newY: integer);
begin
dmc40.GetXY(newX, newY);
end;
procedure TXY_DMC40.SetXY(var newX, newY: integer);
begin
inherited SetXY(newX, newY);
dmc40.SetXY(newX, newY);
end;
procedure TXY_DMC40.SetRelativeXY(deltaX, deltaY: integer);
begin
//jdp - called when user moves stage (by move buttons)
inherited SetRelativeXY(deltaX, deltaY);
if XYTable.InvertX then deltaX := -deltaX;
if XYTable.InvertY then deltaY := -deltaY;
dmc40.SetRelativeXY(deltaX, deltaY);
end;
{synchronous}
procedure TXY_DMC40.MoveToXY(newX, newY: integer);
begin
inherited MoveToXY(newX, newY);
dmc40.MoveToXY(newX, newY);
repeat
Application.ProcessMessages;
until not XYTable.Busy;
end;
procedure TXY_DMC40.ReadXY(var x, y: integer);
begin
dmc40.ReadXY(x, y);
//jdp
//MessageBox(0,pchar(intToStr(x) + ' ' +
// intToStr(y) + ' '),
// 'TXY_DMC40.ReadXY',0);
end;
procedure TXY_DMC40.ShiftByXY(deltaX, deltaY: integer);
begin
inherited ShiftByXY(deltaX, deltaY);
if XYTable.InvertX then deltaX := -deltaX;
if XYTable.InvertY then deltaY := -deltaY;
dmc40.ShiftByXY(deltaX, deltaY);
repeat
Application.ProcessMessages;
until not XYTable.Busy;
end;
procedure TXY_DMC40.XYCommand(const sCommand: string);
begin
dmc40.XYCommand(sCommand);
end;
//PB
procedure TXY_DMC40.GalilWaitForMotionComplete;
begin
dmc40.GalilWaitForMotionComplete;
end;
constructor TXY_DMC40.Create;
begin
inherited Create;
name := 'XY- Galil DMC-40 controller';
dmc40 := TDMC40.Create;
end;
destructor TXY_DMC40.Destroy;
begin
dmc40.Free;
inherited Destroy;
end;
{********************************* TDMC40 ************************************}
{hidden object controlling the Galil controller}
procedure TDMC40.Connect;
begin
if GalilThread.Connected then
fDeviceState := dsDetected
else
fDeviceState := dsNotFound;
end;
procedure TDMC40.GetZ(var newZ: double);
begin
if ZStepper.deviceStatus <> dsDetected then Exit;
GalilThread.GalilAction := GALIL_GET_Z;
ReleaseSemaphore(GalilSemaphore, 1, nil); {starts the thread}
repeat
Application.ProcessMessages;
until not ZStepper.Busy;
newZ := zStepper.ZPosition;
end;
procedure TDMC40.MoveToRelativeZ(newDeltaZ: double);
begin
if ZStepper.deviceStatus <> dsDetected then Exit;
if (mainform.configuration.ScanMode = SM_STACK) and mainform.scanning then
GalilThread.GalilAction:= GALIL_SET_TO_RELATIVE_Z_NO_UPDATE
else
GalilThread.GalilAction:= GALIL_SET_TO_RELATIVE_Z;
GalilThread.GalilParam1 := newDeltaZ;
ReleaseSemaphore(GalilSemaphore, 1, nil); {starts the thread}
end;
//jdz
procedure TDMC40.SetZ(var newZ: double);
begin
if ZStepper.deviceStatus <> dsDetected then Exit;
ZStepper.Busy := True;
GalilThread.GalilAction:= GALIL_SET_Z;
GalilThread.GalilParam1 := newZ;
ReleaseSemaphore(GalilSemaphore, 1, nil); {starts the thread}
end;
procedure TDMC40.MoveToZ(newZ: double);
begin
if ZStepper.deviceStatus <> dsDetected then Exit;
SetZ(newZ);
end;
function TDMC40.ReadZ: double;
begin
if ZStepper.deviceStatus <> dsDetected then
Result := 0
else
begin
GalilThread.GalilAction := GALIL_READ_Z;
ReleaseSemaphore(GalilSemaphore, 1, nil); {starts the thread}
repeat
Application.ProcessMessages;
until not ZStepper.Busy;
Result := zStepper.ZPosition;
end;
end;
procedure TDMC40.ShiftByZ(deltaZ: double);
begin
if ZStepper.deviceStatus <> dsDetected then Exit;
MoveToRelativeZ(deltaZ);
repeat
Application.ProcessMessages;
until not ZStepper.Busy;
end;
procedure TDMC40.GetXY(var newX, newY: integer);
begin
newX := 0; newY := 0;
if ZStepper.deviceStatus <> dsDetected then Exit;
GalilThread.GalilAction := GALIL_GET_XY;
ReleaseSemaphore(GalilSemaphore, 1, nil); {starts the thread}
repeat
Application.ProcessMessages;
until not ZStepper.Busy;
newX := XYTable.XPosition;
newY := XYTable.YPosition;
end;
procedure TDMC40.SetXY(var newX, newY: integer);
begin
if ZStepper.deviceStatus <> dsDetected then Exit;
GalilThread.GalilAction := GALIL_SET_XY;
GalilThread.GalilParam1 := newX;
GalilThread.GalilParam2 := newY;
ReleaseSemaphore(GalilSemaphore, 1, nil); {starts the thread}
end;
procedure TDMC40.SetRelativeXY(deltaX, deltaY: integer);
begin
if ZStepper.deviceStatus <> dsDetected then Exit;
GalilThread.GalilAction := GALIL_SET_TO_RELATIVE_XY;
GalilThread.GalilParam1 := deltaX;
GalilThread.GalilParam2 := deltaY;
ReleaseSemaphore(GalilSemaphore, 1, nil); {starts the thread}
end;
//jd - note this function has changed to do a "one shot"
// fast stack, using continuous motion
// to see how it was previously coded (multiple callbacks),
// check FastStackCallback for other stages
// this will only do one fast stack (down and up)
procedure TDMC40.FastStackCallback;
var newPower: integer;
currentDisplacement: double;
inMo: boolean; //jdz
zPosUm: double; //jdz - last Z position, in microns
zPosInitialUm: double;
zPosFinalUm: double;
temp: double;
begin
//messageBox(0,PAnsiChar(FloatToStr(fastStackInterval)),'In TDMC40.FastStackCallback',0); //PB
// setup;
inMo := true;
GalilThread.GetZ( zPosUm );
zPosInitialUm := zPosUm;
zPosFinalUm := zPosUm + GalilThread.fastStackDistance; // generally, fastStackDistance will be negative
// set to initial power here
LaserControl.Power := Round(Mainform.Configuration.InitialIntensity);
while inMo do
begin
//if inMo then messageBox(0,'true (moving)','',0)
//else messageBox(0,'false (not moving)','',0);
Delay(50); // don't check stage constantly
inMo := GalilThread.InMotionZ; // check the motion
GalilThread.GetZ( zPosUm ); // get current position
// messageBox(0,pansiChar(floatToStr(zPosUm)),'',0);
// stop motion if no longer scanning (if user exits)
if mainform.scanning = false then
begin
inMo := false;
GalilThread.StopMotion;
end;
{Adjust laser power here, if enabled}
with Mainform.Configuration, Mainform.engine do
if IntensityControl <> IC_NO_CONTROL then
begin
currentDisplacement := zPosUm - zPosInitialUm;
if IntensityControl = IC_LINEAR then
begin
newPower := Round(InitialIntensity +
currentDisplacement/AtZDistance * (FinalIntensity - InitialIntensity));
end
else
begin
if InitialIntensity <= 0 then InitialIntensity := 1; // don't divide by 0
newPower := Round(InitialIntensity *
exp(currentDisplacement * Ln(FinalIntensity/InitialIntensity) / AtZDistance));
end;
if Abs(newPower - LaserControl.Power) <> 0 then
begin
analogOutputBoard.AnalogOut(1, newPower/10);
LaserControl.Power := newPower;
end;
end;
end; // in inMo loop
// done with fast stack
// (either stage stopped moving, or user pressed stop
GalilThread.ResetSpeedAndPosAfterFastStackZ; // return to original speed
// return to original power
LaserControl.Power := Round(Mainform.Configuration.InitialIntensity);
//jdz - this will call WMFASTSTACKENDED and stop the scan, and return stage
PostMessage(Mainform.Handle, WM_FASTSTACK_ENDED, 0, 0);
end;
procedure TDMC40.MoveToXY(newX, newY: integer);
begin
if ZStepper.deviceStatus <> dsDetected then Exit;
XYTable.Busy := True;
GalilThread.GalilAction := GALIL_MOVE_TO_XY;
GalilThread.GalilParam1 := newX;
GalilThread.GalilParam2 := newY;
ReleaseSemaphore(GalilSemaphore, 1, nil); {starts the thread}
end;
procedure TDMC40.ReadXY(var x, y: integer);
begin
x := 0; y := 0;
if ZStepper.deviceStatus <> dsDetected then Exit;
GetXY(x, y);
end;
procedure TDMC40.ShiftByXY(deltaX, deltaY: integer);
begin
if ZStepper.deviceStatus <> dsDetected then Exit;
GalilThread.GalilAction := GALIL_SHIFT_BY_XY;
GalilThread.GalilParam1 := deltaX;
GalilThread.GalilParam2 := deltaY;
ReleaseSemaphore(GalilSemaphore, 1, nil); {starts the thread}
end;
procedure TDMC40.XYCommand(const sCommand: string);
begin
GalilThread.GalilAction := GALIL_COMMAND;
GalilThread.GalilCommandString := sCommand;
ReleaseSemaphore(GalilSemaphore, 1, nil); {starts the thread}
end;
//PB
procedure TDMC40.GalilWaitForMotionComplete;
begin
//add stuff
end;
procedure TDMC40.StartFastStack(fsSpeed: integer; deltaZ: double);
begin
if ZStepper.deviceStatus <> dsDetected then Exit;
// SetZSpeed(fsSpeed);
repeat
Application.ProcessMessages;
until not ZStepper.Busy;
GalilThread.GalilAction := GALIL_FAST_STACK;
//jdz - pass in parameters needed by the fast stack
GalilThread.fastStackInterval := deltaZ; // (microns) not currently used
GalilThread.fastStackSpeed := fsSpeed; // number between 1-60 (microns per sec)
GalilThread.fastStackDistance := Mainform.configuration.zDistance; // microns
ReleaseSemaphore(GalilSemaphore, 1, nil); {starts the thread}
end;
constructor TDMC40.Create;
begin
inherited Create;
GalilSemaphore := CreateSemaphore(nil, 0, 1, nil);
GalilThread := TGalilThread.Create(True);
GalilThread.ConnectToGalil;
GalilThread.Resume;
end;
destructor TDMC40.Destroy;
begin
GalilThread.Terminate;
Delay(1000); //jd wait for thread to terminate
CloseHandle(GalilSemaphore);
inherited Destroy;
end;
end.
Raw
MP file
unit mpfileu;
interface
uses Windows, Messages, SysUtils, Classes, Graphics, Forms, Registry, StdCtrls, ActiveX,
ComObj, mpviewu, vfw;
type
TMPFile = class;
TFrame = class
private
chIndex, frameIndex: integer;
mpFile: TMPFile;
procedure LoadFromFile(frameIndex: integer); virtual; abstract;
public
data: array of int16;
constructor Create(mp_File: TMPFile; iChIndex, iFrameIndex: integer);
end;
TVideoFrame = class(TFrame)
private
function GetHeight: integer;
function GetPixels(x, y: integer): int16;
function GetWidth: integer;
procedure LoadFromFile(frameIndex: integer); override;
procedure SaveToFile;
public
procedure CopyData(dest: TVideoFrame);
procedure CopyToDoubleArray(var dblArray: array of double);
procedure GammaCorrection(blackLevel, whiteLevel: integer);
procedure GetProfile(binSize: integer; var histogram: array of integer);
constructor Create(mp_File: TMPFile; iChIndex, iFrameIndex: integer);
property Height: integer read GetHeight;
property Pixels[x, y: integer]: int16 read GetPixels;
property Width: integer read GetWidth;
end;
TAnalogFrame = class(TFrame)
{x: index of analog sample in frame data}
private
function GetIAnalogValue(x: integer): integer;
function GetfAnalogValue(x: integer): double;
procedure LoadFromFile(frameIndex: integer); override;
public
function SampleToAbsoluteTime(x: integer): double; {in seconds}
constructor Create(mp_File: TMPFile; iChIndex, iFrameIndex: integer);
property iAnalogValue[x: integer]: integer read GetIAnalogValue;
property fAnalogValue[x: integer]: double read GetfAnalogValue;
end;
TFrameCommentList = class(TStringList)
private
mpFile: TMPFile;
procedure SaveFrameComments;
procedure LoadFrameComments;
function GetFrameComment(frameIndex: integer): string;
procedure SetFrameComment(frameIndex: integer; const frameComment: string);
public
constructor Create(theMPFile: TMPFile);
property FrameComment[frameIndex: integer]: string read GetFrameComment write SetFrameComment;
end;
TFrameGroup = class
private
fWidth, fHeight, fFrameIndex: integer;
mpFile: TMPFile;
procedure LoadFromFile(frameIndex: integer);
{ procedure SaveToFile;}
procedure SetFrameWidth(newWidth: integer);
procedure SetFrameHeight(newHeight: integer);
procedure SetFrameIndex(newIndex: integer);
public
comments: string;
channels: array[0..MAX_CH - 1] of TFrame; {0..1: TVideoFrame; 2..3: TAnalogFrame}
property FrameIndex: integer read fFrameIndex write SetFrameIndex;
property FrameWidth: integer read fWidth write SetFrameWidth;
property FrameHeight: integer read fHeight write SetFrameHeight;
constructor Create(mp_file: TMPFile);
constructor CreateTempFrameGroup(mp_file: TMPFile);
constructor CreateForOp(mp_file: TMPFile); {creates a frame group for operations: only channels[0] is valid}
destructor Destroy; override;
end;
//-------------------------------- FILE OBJECT ------------------------------
TIntensityControl = (IC_NO_CONTROL, IC_LINEAR, IC_EXPONENTIAL);
TMPFile = class
private
fActiveFrameIndex: integer;
fAngle: integer;
{fbLineForXScan, OBSOLETE}
fbIsMemoryFile, fbClosing: boolean;
fChConvFactors: array[0..MAX_CH -1] of double;
fChDataPtsPerFrames: array[0..MAX_CH -1] of integer;
fChEnabled, fIsVideoCh: array[0..MAX_CH - 1] of boolean;
fChInputRanges: array[0..MAX_CH - 1] of TFullScaleVal;
fChNames: array[0..MAX_CH - 1] of string;
fChMaxPixelValues: array[0..MAX_CH - 1] of integer;
fChOffsets: array[0..MAX_CH -1] of double;
fChPrefixes: array[0..MAX_CH -1] of TPrefix;
fChUnits: array[0..MAX_CH - 1] of string;
fFilename: string;
fFrameCount: integer;
fFrameHeight,
fFrameWidth: integer;
fLineRepeatCount: integer;
fMagnification: double;
fPixelClock {in increments of 50 ns (= 20 MHz)}: integer;
fResolution: TFrameResolution; {RESOLUTION_8_BITS, 12, 16 bits}
fRotation: integer;
fScanMode: TScanMode;
fStackAveragingCount,
fStackFrameCount: integer;
fStackInterval: double;
fStackRepeatCount,
fXFrameOffset,
fXStagePosition,
fYFrameOffset,
fYStagePosition: integer;
fZStagePosition: double;
sComments: string;
fzDistance: double;
fTravelDuration: string;
fFastStackRepeatCount: integer;
fInitialIntensity, fFinalIntensity: integer;
fAtZDistance: double;
fIntensityControl: TIntensityControl;
RegionPts: array of TPoint; {for region scans}
chStreams: array[0..MAX_CH -1] of IStream;
propertyStorage: IPropertyStorage;
propertySetStorage: IPropertySetStorage;
rootStorage: IStorage;
fCurrentFrameGroup: TFrameGroup;
frameCommentList: TFrameCommentList;
frameGroupList: TList;
bDirty: boolean;
{ function GetActiveFrameGroup: TFrameGroup;}
procedure AdjustFrameCount;
function GetAnalogChCount: integer;
function GetAnalogChEnabled(chIndex: integer): boolean;
function GetAnalogWndCount: integer;
function GetAnalogWnds(wndIndex: integer): TForm;
function GetChAcquisitionRate(chIndex: integer): double;
function GetChConvFactor(chIndex: integer): double;
function GetChDataPtsPerFrame(chIndex: integer): integer;
function GetChEnabled(chIndex: integer): boolean;
function GetChInputRange(chIndex: integer): TFullScaleVal;
function GetChMaxPixelValues(chIndex: integer): integer;
function GetChNames(chIndex: integer): string;
function GetChUnit(chIndex: integer): string;
function GetChPrefix(chIndex: integer): TPrefix;
function GetChOffset(chIndex: integer): double;
{ function GetCurrentFrame(chIndex: integer): TFrame;}
function GetDefaultVideoChannel: integer;
function GetFrameComment(frameIndex: integer): string;
function GetFrameCount: integer;
function GetFrameRate: double; {in frames per seconds}
function GetFrameSize: integer;
function GetFrames(frameIndex: integer): TFrameGroup;
function GetFullFrameSize: integer;
function GetIsVideoChannel(chIndex: integer): boolean;
function GetMaxPixelValue: integer;
procedure GetRegions;
function GetResolution: string;
function GetVideoChCount: integer;
function GetVideoChEnabled(chIndex: integer): boolean;
function GetViewerCount: integer;
function GetViewers(viewerIndex: integer): TForm;
procedure InitializeColors;
procedure LoadFrameGroup(newIndex: integer);
procedure ReadPropertySet;
procedure SetActiveFrameIndex(newIndex: integer);
procedure SetFrameComment(frameIndex: integer; sComments: string);
procedure WritePropertySet;
public
viewerList, analogWndList: TList;
{custom LUTs}
baseColors: TBaseColorsArray;
negativeColors,
midRangeColors,
maxColors: TRangeColorsArray;
maxPixels: TMaxPixelsArray;
CustomColors: array[0..MAX_CH - 1, 0..MAX_FALSE_COLORS - 1] of TRGBTriple;
procedure AddFrameGroup(newFrameGroup: TFrameGroup);
procedure AverageFrames(chIndex, fromFrame, toFrame: integer; dest: TMPFile);
procedure BinaryOp(file1, file2: TMPFile; ch1, ch2, frame1, frame2: integer; gain1, gain2: double;
resultFrame: integer);
procedure Close(Sender: TObject);
function CreateEmptyFrame(fromFile: TMPFile): integer;
procedure CopyChannelsToClipboard(bCh2, bCh3: boolean; fromFrame, toFrame: integer);
procedure CopyFrames(chIndex, fromFrame, toFrame: integer; dest: TMPFile); {from one file to a memory file, rect to rect}
procedure CloneROIs(ROIList: TROIList; fromIndex: integer); {duplicate each ROI but with opposite channel}
procedure DetectROIs(ROIList: TROIList; chIndex, fromFrame, toFrame, threshold, minArea,
templateFrom, templateTo: integer);
function DigitalToAnalog(chIndex, iValue: integer): double;
procedure DoBackgroundCorrection;
function GetAverage(frameIndex, chIndex: integer; rc: TRect): integer;
function GetROIAverageValue(ROIList: TROIList; roiIndex, frameIndex: integer): integer;
function GetPixelValue(frameIndex, chIndex, xData, yData: integer): int16;
function GetMax(frameIndex, chIndex: integer; rc: TRect; var x, y: integer): integer;
function GetMin(frameIndex, chIndex: integer; rc: TRect; var x, y: integer): integer;
function GetPropertyValue(propName: string): string;
function IsOperationOK(chIndex, fromFrame, toFrame: integer; dest: TMPFile): boolean;
procedure MakeAVIMovie(const avifilename: string; chIndex, fromFrame, toFrame, newframeRate: integer;
colorScheme: TColorScheme; fromViewer: TObject; bOverlayCh1on2: boolean);
function MakeTIFF(const avifilename: string; chIndex, fromFrame, toFrame: integer): boolean;
procedure NewAnalogWnd;
procedure NewViewer;
procedure OnNewFrames;
procedure OnWndClose(wnd: TForm); {when a viewer or analog wnd closes}
procedure SaveChannelsToFile(bASCII: boolean; fname: string; bCh2, bCh3: boolean; fromFrame, toFrame: integer);
function SizeOfFrameCompatible(width, height: integer): boolean;
procedure StackX(chIndex, fromFrame, toFrame, fromY, toY: integer; dest: TMPFile);
procedure StackY(chIndex, fromFrame, toFrame, fromX, toX: integer; dest: TMPFile);
procedure StackZ(chIndex, fromFrame, toFrame: integer; dest: TMPFile);
function SaveAs(const sFilename: string): TFileErr;
procedure SubtractFrame(chIndex, plusFrameIndex, minusFrameIndex: integer; dest: TMPFile);
constructor CreateFromTemplate(const sFilename: string; templateFile: TMPFile);
constructor CreateFromFile(const sFilename: string);
destructor Destroy; override;
property ActiveFrameIndex: integer read fActiveFrameIndex write SetActiveFrameIndex;
property AnalogChCount: integer read GetAnalogChCount;
property AnalogChEnabled[chIndex: integer]: boolean read GetAnalogChEnabled;
property AnalogWndCount: integer read GetAnalogWndCount;
property AnalogWnds[wndIndex: integer]: TForm read GetAnalogWnds;
property Angle: integer read fAngle;
property ChAcquisitionRate[chIndex: integer]: double read GetChAcquisitionRate;
property ChConvFactor[chIndex: integer]: double read GetChConvFactor;
property ChDataPtsPerFrame[chIndex: integer]: integer read GetChDataPtsPerFrame;
property ChEnabled[chIndex: integer]: boolean read GetChEnabled;
property ChInputRange[chIndex: integer]: TFullScaleVal read GetChInputRange;
property ChNames[chIndex: integer]: string read GetChNames;
property ChUnit[chIndex: integer]: string read GetChUnit;
property ChMaxPixelValues[chIndex: integer]: integer read GetChMaxPixelValues;
property ChPrefix[chIndex: integer]: TPrefix read GetChPrefix;
property ChOffset[chIndex: integer]: double read GetChOffset;
property Closing: boolean read fbClosing; {when user closes file from menu}
property Comments: string read sComments write sComments;
property DefaultVideoChannel: integer read GetDefaultVideoChannel;
property Filename: string read ffilename;
property FrameComment[frameIndex: integer]: string read GetFrameComment
write SetFrameComment;
property FrameCount: integer read GetFrameCount;
property FrameHeight: integer read fFrameHeight;
property FrameRate: double read GetFrameRate; {in frames per second}
property FrameSize: integer read GetFrameSize; {in samples}
property Frames[frameIndex: integer]: TFrameGroup read GetFrames;
property FrameWidth: integer read fFrameWidth;
property FullFrameSize: integer read GetFullFrameSize; {= Frame size + "forgotten pixels"}
property IsMemoryFile: boolean read fbIsMemoryFile;
property IsVideoChannel[chIndex: integer]: boolean read GetIsVideoChannel;
property LineRepeatCount: integer read fLineRepeatCount;
{ property LineForXScan: boolean read fbLineForXScan;}
property Magnification: double read fMagnification;
property MaxPixelValue: integer read GetMaxPixelValue; {255, 2047 or 32767}
property PixelClock: integer read fPixelClock; {in ns}
property Resolution: string read GetResolution;
property Rotation: integer read fRotation;
property VideoChCount: integer read GetVideoChCount;
property VideoChEnabled[chIndex: integer]: boolean read GetVideoChEnabled;
property ViewerCount: integer read GetViewerCount;
property Viewers[viewerIndex: integer]: TForm read GetViewers;
property ScanMode: TScanMode read fScanMode;
property StackAveragingCount: integer read fStackAveragingCount;
property StackFrameCount: integer read fStackFrameCount;
property StackInterval: double read fStackInterval;
property StackRepeatCount: integer read fStackRepeatCount;
property XFrameOffset: integer read fXFrameOffset;
property XStagePosition: integer read fXStagePosition;
property YFrameOffset: integer read fYFrameOffset;
property YStagePosition: integer read fYStagePosition;
property ZStagePosition: double read fZStagePosition;
end;
//------------------------------- FILE LIST ---------------------------------
{holds all the files}
TFileList = class(TStringList)
private
function IsMPFile(const sFilename: string): boolean;
function GetTemporaryFileName: string;
function Load(const sFilename: string): TFileErr;
public
dataDirectory: string;
procedure FillComboBoxWithWorkspaces(aComboBox: TComboBox);
procedure NotifyFileClosing(Sender: TMPFile);
procedure NewFile(templateFile: TMPFile);
procedure Open(const sFilename: string);
procedure SaveFileAs(mpFile: TMPFile; const newName: string);
function WorkspaceCount: integer;
destructor Destroy; override;
end;
function BoolToString(b: Boolean): string;
{function LineForXScanToString(bLine: boolean): string; OBSOLETE}
{function StringToLineForXScan(s: string): boolean;}
function ScanModeToString(smode: TScanMode): string;
function StringToScanMode(s: string): TScanMode;
function StringToBool(s: string): Boolean;
function StringToInputRange(s: string): TFullScaleVal;
function StringToPrefix(s: string): TPrefix;
function IntensityControlToString(ic: TIntensityControl): string;
{******************************************************************************}
{*} {*}
{*} IMPLEMENTATION {*}
{*} {*}
{******************************************************************************}
uses mainfrm, Math, analogu, vieweru, dialogs, Clipbrd;
const
TIFF_TAG_COUNT = 22; {Includes ImageDescription tag}
TIFF_ASCII = 2;
TIFF_SHORT = 3;
TIFF_LONG = 4;
TIFF_RATIONAL = 5;
TIFF_ImageDescription = 270;
FILE_PROP_COUNT = 74; {74 default properties per file in property set}
type
TTIFFHeader = packed record
order,
signature: Word;
IFDOffset: integer;
end;
TTagRecord = packed record
tagID, tagType: Word;
count, dataOffset: integer;
end;
TIFD = packed record
count: Word;
tagRecords: array[1..TIFF_TAG_COUNT] of TTagRecord;
nextIDFoffset: integer;
XNum, XDenom,
YNum, YDenom: integer;
end;
{followed by image description ASCII string}
const
TiffHeader: TTIFFHeader = (order: $4949; signature: 42; IFDOffset: 8);
OFLAGS = STGM_DIRECT or STGM_READWRITE or STGM_CREATE or STGM_SHARE_EXCLUSIVE;
RFLAGS = STGM_DIRECT or STGM_READ or STGM_SHARE_EXCLUSIVE;
FMTID_User_Defined_Properties: TGUID = '{D5CDD505-2E9C-101B-9397-08002B2CF9AE}';
sTIFFPropNames: string =
'Channel: %d' + #13#10 +
'Resolution: %s' + #13#10 +
'Scan Mode: %s' + #13#10 +
'X Stage Position (microns): %d' + #13#10 +
'Y Stage Position (microns): %d' + #13#10 +
'Z Stage Position (microns): %f' + #13#10 +
'Section Count: %d' + #13#10 +
'z- Interval (microns): %f' + #13#10 +
'Frames Per Section: %d' + #13#10 +
'Stack Repeat Count: %d' + #13#10 +
'Magnification: x%f' + #13#10 +
'Rotation (degrees): %d' + #13#10 +
'X Frame Offset (pixels): %d' + #13#10 +
'Y Frame Offset (pixels): %d' + #13#10 +
'Frame Rate (fps): %f';
sPropNames: array[0..FILE_PROP_COUNT - 1] of string = (
'Resolution',
'Scan Mode',
'X Frame Offset',
'Y Frame Offset',
'Frame Width',
'Frame Height',
'Pixel Clock',
'Channel name (1)', 'Enabled (1)', 'Input Range (1)',
'Channel name (2)', 'Enabled (2)', 'Input Range (2)',
'Channel name (3)', 'Enabled (3)', 'Input Range (3)', 'Channel Unit (3)',
'Channel Prefix (3)', 'Conversion factor (3)', 'Offset (3)', 'Data Points Per Frame (3)',
'Channel name (4)', 'Enabled (4)', 'Input Range (4)', 'Channel Unit (4)',
'Channel Prefix (4)', 'Conversion factor (4)', 'Offset (4)', 'Data Points Per Frame (4)',
'Frame Count',
'X Position',
'Y Position',
'Z Position',
'Section Count',
'z- Interval',
'Averaging Count',
'Repeat Count',
'Magnification',
'Rotation',
'Comments',
'Is Video Channel (3)',
'Is Video Channel (4)',
'z- Distance',
'Travel Duration',
'Fast Stack Repeat Count',
'Initial Intensity',
'Final Intensity',
'At Z- Distance',
'Intensity Control',
'Ch Max Pixel Value (1)',
'Ch Max Pixel Value (2)',
'Ch Max Pixel Value (3)',
'Ch Max Pixel Value (4)', {53 props}
slutType,
'Base Color (1)',
'Base Color (2)',
'Base Color (3)',
'Base Color (4)',
'Negative Color (1)',
'Negative Color (2)',
'Negative Color (3)',
'Negative Color (4)',
'MidRange Color (1)',
'MidRange Color (2)',
'MidRange Color (3)',
'MidRange Color (4)',
'Max Color (1)',
'Max Color (2)',
'Max Color (3)',
'Max Color (4)',
'Max Pixel Value of LUT (1)',
'Max Pixel Value of LUT (2)',
'Max Pixel Value of LUT (3)',
'Max Pixel Value of LUT (4)'
);
sAlreadyLoaded = 'File %s is already opened in MPView.';
procedure MakeIFD(var IFD: TIFD);
begin
with IFD do
begin
count := TIFF_TAG_COUNT;
tagRecords[1].tagID := 254; {NewSubtitleType}
tagRecords[1].tagType := TIFF_LONG;
tagRecords[1].count := 1;
tagRecords[1].dataOffset := 0;
tagRecords[2].tagID := 256; {ImageWidth}
tagRecords[2].tagType := TIFF_LONG;
tagRecords[2].count := 1;
tagRecords[3].tagID := 257; {ImageLength}
tagRecords[3].tagType := TIFF_LONG;
tagRecords[3].count := 1;
tagRecords[4].tagID := 258; {BitsPerSample}
tagRecords[4].tagType := TIFF_SHORT;
tagRecords[4].count := 1;
tagRecords[4].dataOffset := 16;
tagRecords[5].tagID := 259; {Compression}
tagRecords[5].tagType := TIFF_SHORT;
tagRecords[5].count := 1;
tagRecords[5].dataOffset := 1; {No compression}
tagRecords[6].tagID := 262; {PhotometricInterpretation}
tagRecords[6].tagType := TIFF_SHORT;
tagRecords[6].count := 1;
tagRecords[6].dataOffset := 1; {BlackIsZero}
tagRecords[7].tagID := 263; {Tresholding}
tagRecords[7].tagType := TIFF_SHORT;
tagRecords[7].count := 1;
tagRecords[7].dataOffset := 1;
tagRecords[8].tagID := 266; {FillOrder}
tagRecords[8].tagType := TIFF_SHORT;
tagRecords[8].count := 1;
tagRecords[8].dataOffset := 1;
tagRecords[9].tagID := 273; {StripOffsets}
tagRecords[9].tagType := TIFF_LONG;
tagRecords[9].count := 1;
tagRecords[10].tagID := 274; {Orientation}
tagRecords[10].tagType := TIFF_SHORT;
tagRecords[10].count := 1;
tagRecords[10].dataOffset := 1;
tagRecords[11].tagID := 277; {SamplesPerPixel}
tagRecords[11].tagType := TIFF_SHORT;
tagRecords[11].count := 1;
tagRecords[11].dataOffset := 1;
tagRecords[12].tagID := 278; {RowsPerStrip}
tagRecords[12].tagType := TIFF_LONG;
tagRecords[12].count := 1;
tagRecords[13].tagID := 279; {StripByteCounts}
tagRecords[13].tagType := TIFF_LONG;
tagRecords[13].count := 1;
tagRecords[14].tagID := 280; {MinSampleValue}
tagRecords[14].tagType := TIFF_SHORT;
tagRecords[14].count := 1;
tagRecords[14].dataOffset := 0;
tagRecords[15].tagID := 281; {MaxSampleValue}
tagRecords[15].tagType := TIFF_SHORT;
tagRecords[15].count := 1;
tagRecords[15].dataOffset := 65535;
tagRecords[16].tagID := 282; {XResolution}
tagRecords[16].tagType := TIFF_RATIONAL;
tagRecords[16].count := 1;
tagRecords[17].tagID := 283; {YResolution}
tagRecords[17].tagType := TIFF_RATIONAL;
tagRecords[17].count := 1;
tagRecords[18].tagID := 284; {PlanarConfiguration}
tagRecords[18].tagType := TIFF_SHORT;
tagRecords[18].count := 1;
tagRecords[18].dataOffset := 1; {Chunky}
tagRecords[19].tagID := 290; {GrayResponseUnit}
tagRecords[19].tagType := TIFF_SHORT;
tagRecords[19].count := 1;
tagRecords[19].dataOffset := 1;
tagRecords[20].tagID := 296; {ResolutionUnit}
tagRecords[20].tagType := TIFF_SHORT;
tagRecords[20].count := 1;
tagRecords[20].dataOffset := 2; {Inch}
tagRecords[21].tagID := 339; {SampleFormat}
tagRecords[21].tagType := TIFF_SHORT;
tagRecords[21].count := 1;
tagRecords[21].dataOffset := 1;
tagRecords[22].tagID := TIFF_ImageDescription;
tagRecords[22].tagType := TIFF_ASCII;
XNum := 72;
XDenom := 1;
YNum := 72;
YDenom := 1;
end;
end;
{
OBSOLETE FUNCTIONS
function LineForXScanToString(bLine: boolean): string;
begin
if bLine then Result := 'Line' else Result := 'Sine';
end;
function StringToLineForXScan(s: string): boolean;
begin
Result := (s = 'Line');
end;}
function ScanModeToString(smode: TScanMode): string;
begin
case smode of
SM_MOVIE: Result := 'Movie';
SM_STACK: Result := 'Image Stack';
{ SM_STACKMOVIE: Result := 'Image Stack Movie';}
SM_LINESCAN: Result := 'Line Scan';
SM_REPEAT_LINESCAN: Result := 'Repeat Line Scan';
SM_REGIONSCAN: Result := 'Region Scan';
else Result := '';
end
end;
function StringToScanMode(s: string): TScanMode;
begin
if s = 'Movie' then Result := SM_MOVIE else
if s = 'Image Stack' then Result := SM_STACK else
{ if s = 'Image Stack Movie' then Result := SM_STACKMOVIE else}
if s = 'Line Scan' then Result := SM_LINESCAN else
if s = 'Repeat Line Scan' then Result := SM_REPEAT_LINESCAN else
if s = 'Region Scan' then Result := SM_REGIONSCAN else
Result := SM_MOVIE;
end;
function BoolToString(b: Boolean): string;
begin
if b then Result := 'True' else Result := 'False';
end;
function StringToBool(s: string): Boolean;
begin
Result := (s = 'True');
end;
function StringToInputRange(s: string): TFullScaleVal;
begin
if s = Chr(177) + '42V' then Result := pm_42V else
if s = Chr(177) + '20V' then Result := pm_20V else
if s = Chr(177) + '10V' then Result := pm_10V else
if s = Chr(177) + '5V' then Result := pm_5V else
if s = Chr(177) + '2V' then Result := pm_2V else
if s = Chr(177) + '1V' then Result := pm_1V else
if s = Chr(177) + '0.5V' then Result := pm_0_5V else
if s = Chr(177) + '0.2V' then Result := pm_0_2V else
Result := pm_10V;
end;
function StringToPrefix(s: string): TPrefix;
begin
if s = 'x' then Result := tpXENNO else
if s = 'y' then Result := tpYOCTO else
if s = 'z' then Result := tpZEPTO else
if s = 'a' then Result := tpATTO else
if s = 'f' then Result := tpFEMTO else
if s = 'p' then Result := tpPICO else
if s = 'n' then Result := tpNANO else
if s = #181 then Result := tpMICRO else
if s = 'm' then Result := tpMILLI else
if s = '' then Result := tpUNITY else
if s = 'k' then Result := tpKILO else
if s = 'M' then Result := tpMEGA else
if s = 'G' then Result := tpGIGA else
if s = 'T' then Result := tpTERA else
if s = 'P' then Result := tpPETA else
if s = 'E' then Result := tpECTA else
if s = 'Z' then Result := tpZETTA else
if s = 'Y' then Result := tpYOTTA else
if s = 'X' then Result := tpXENNA else
Result := tpUNITY;
end;
//-------------------------------- FRAME --------------------------------------
constructor TFrame.Create(mp_File: TMPFile; iChIndex, iFrameIndex: integer);
var i: integer;
begin
mpFile := mp_File;
frameIndex := iFrameIndex;
chIndex := iChIndex;
SetLength(data, mpFile.FrameWidth * mpFile.FrameHeight);
if mpFile.ScanMode = SM_REGIONSCAN then
for i := 0 to Length(data) - 1 do data[i] := 0;
end;
//------------------------------ VIDEO FRAME ----------------------------------
function TVideoFrame.GetHeight: integer;
begin
Result := mpFile.FrameHeight;
end;
function TVideoFrame.GetPixels(x, y: integer): int16;
begin
Result := data[x + y * Width];
end;
function TVideoFrame.GetWidth: integer;
begin
Result := mpFile.FrameWidth;
end;
procedure TVideoFrame.LoadFromFile(frameIndex: integer);
var libNewPosition: Largeint;
i: integer;
pt: TPoint;
tempData: array of int16;
begin
OleCheck(mpFile.chStreams[chIndex].Seek(frameIndex * mpFile.FrameSize * SizeOf(int16)
, STREAM_SEEK_SET, libNewPosition));
if mpFile.ScanMode <> SM_REGIONSCAN then
OleCheck(mpFile.chStreams[chIndex].Read(@data[0], mpFile.FrameSize * SizeOf(int16), nil))
else
begin
{Region scan: the frame is 512 x 512, we fill with data indexed by RegionPts}
SetLength(tempData, mpFile.FrameSize);
OleCheck(mpFile.chStreams[chIndex].Read(@tempData[0], mpFile.FrameSize * SizeOf(int16), nil));
for i := 0 to mpFile.FrameSize - 1 do
begin
pt := mpFile.RegionPts[i];
data[pt.x + pt.y * mpFile.FrameWidth] := tempData[i];
end;
end;
end;
procedure TVideoFrame.SaveToFile;
begin
mpFile.chStreams[chIndex].Write(@data[0], Width * Height * SizeOf(int16), nil);
end;
procedure TVideoFrame.CopyData(dest: TVideoFrame);
var i: integer;
begin
for i := 0 to Width * Height - 1 do
dest.data[i] := data[i];
end;
procedure TVideoFrame.GammaCorrection(blackLevel, whiteLevel: integer);
var i: integer;
maxPixelVal, pixelVal: int16;
begin
maxPixelVal := mpFile.ChMaxPixelValues[chIndex];
for i := 0 to Width * Height - 1 do
begin
pixelVal := data[i];
if pixelVal > whiteLevel then
pixelVal := maxPixelVal
else if pixelVal < blackLevel then
pixelVal := 0
else
pixelVal := int16(Muldiv(integer(pixelVal) - blackLevel, maxPixelVal,
whiteLevel - blackLevel));
data[i] := pixelVal;
end;
end;
procedure TVideoFrame.GetProfile(binSize: integer; var histogram: array of integer);
var binCount, i, j: integer;
begin
if (binSize <= 0) or (binSize > 1024) then Exit;
binCount := DEFAULT_MAX_PIXEL_VALUE + 1 div binSize + 1;
{ SetLength(histogram, binCount);}
for i := 0 to binCount - 1 do
histogram[i] := 0;
for i := 0 to Width * Height - 1 do
for j := 0 to binCount - 1 do
begin
if j = 0 then
begin
if data[i] < 0 then histogram[0] := histogram[0] + 1;
end
else
if (data[i] >= (j - 1) * binSize) and (data[i] < (j * binSize)) then
histogram[j] := histogram[j] + 1;
end;
end;
procedure TVideoFrame.CopyToDoubleArray(var dblArray: array of double);
var i: integer;
begin
for i := 0 to Width * Height - 1 do
dblArray[i] := data[i];
end;
constructor TVideoFrame.Create(mp_File: TMPFile; iChIndex, iFrameIndex: integer);
begin
inherited Create(mp_File, ichIndex, iFrameIndex);
SetLength(data, mpFile.FrameWidth * mpFile.FrameHeight);
end;
///------------------------------ ANALOG FRAME ---------------------------------
function TAnalogFrame.SampleToAbsoluteTime(x: integer): double; {in seconds}
begin
Result := (frameIndex + x / mpFile.ChDataPtsPerFrame[chIndex]) / mpFile.FrameRate;
end;
function TAnalogFrame.GetIAnalogValue(x: integer): integer;
begin
Result := data[x];
end;
function TAnalogFrame.GetfAnalogValue(x: integer): double;
begin
Result := mpFile.DigitalToAnalog(chIndex, data[x]);
end;
procedure TAnalogFrame.LoadFromFile(frameIndex: integer);
var libNewPosition: Largeint;
begin
mpFile.chStreams[chIndex].Seek(STREAM_SEEK_SET,
frameIndex * mpFile.ChDataPtsPerFrame[chIndex] * SizeOf(int16), libNewPosition);
mpFile.chStreams[chIndex].Read(@data[0], mpFile.ChDataPtsPerFrame[chIndex] * SizeOf(int16), nil);
end;
constructor TAnalogFrame.Create(mp_File: TMPFile; iChIndex, iFrameIndex: integer);
begin
inherited Create(mp_File, ichIndex, iFrameIndex);
SetLength(data, mpFile.fChDataPtsPerFrames[iChIndex]);
end;
//--------------------------- FRAME COMMENT LIST ------------------------------
procedure TFrameCommentList.SaveFrameComments;
var commentStream: IStream;
i, j: integer;
s: string;
begin
if Count > 0 then
if Succeeded(mpFile.rootStorage.CreateStream('Frame comments', OFLAGS, 0, 0, commentStream)) then
begin
j := Count - 1;
commentStream.Write(@j, SizeOf(j), nil);
for i := 0 to Count - 1 do
begin
j := Integer(Objects[i]);
commentStream.Write(@j, SizeOf(j), nil);
j := Length(Strings[i]);
commentStream.Write(@j, SizeOf(j), nil);
s := Strings[i];
commentStream.Write(@s[1], j, nil);
end;
commentStream := nil;
end;
end;
procedure TFrameCommentList.LoadFrameComments;
var commentStream: IStream;
i, frameIndex, stringLength, frameCount: integer;
s: string;
begin
if Succeeded(mpFile.rootStorage.OpenStream('Frame comments', nil, RFLAGS, 0, commentStream)) then
begin
commentStream.Read(@frameCount, SizeOf(frameCount), nil);
if frameCount >= 0 then
for i := 0 to frameCount do
begin
commentStream.Read(@frameIndex, SizeOf(frameIndex), nil);
commentStream.Read(@stringLength, SizeOf(stringLength), nil);
if stringLength > 0 then
begin
SetLength(s, stringLength);
commentStream.Read(@s[1], stringLength, nil);
AddObject(s, TObject(frameIndex));
end;
end;
commentStream := nil;
end;
end;
function TFrameCommentList.GetFrameComment(frameIndex: integer): string;
begin
Result := '';
if (Count > 0) and (IndexOfObject(TObject(frameIndex)) >= 0) then
Result := Strings[IndexOfObject(TObject(frameIndex))];
end;
procedure TFrameCommentList.SetFrameComment(frameIndex: integer; const frameComment: string);
begin
if IndexOfObject(TObject(frameIndex)) >= 0 then
Strings[IndexOfObject(TObject(frameIndex))] := frameComment
else
AddObject(frameComment, TObject(frameIndex));
end;
constructor TFrameCommentList.Create(theMPFile: TMPFile);
begin
mpFile := theMPFile;
end;
//------------------------------ FRAME GROUP ----------------------------------
procedure TFrameGroup.LoadFromFile(frameIndex: integer);
var i: integer;
begin
for i := 0 to MAX_CH - 1 do
if channels[i] <> nil then
channels[i].LoadFromFile(frameIndex);
end;
procedure TFrameGroup.SetFrameIndex(newIndex: integer);
var i: integer;
begin
fFrameIndex := newIndex;
for i := 0 to MAX_CH - 1 do
if channels[i] <> nil then channels[i].frameIndex := newIndex;
end;
procedure TFrameGroup.SetFrameWidth(newWidth: integer);
begin
fWidth := newWidth;
end;
procedure TFrameGroup.SetFrameHeight(newHeight: integer);
begin
fHeight := newHeight;
if channels[0] <> nil then SetLength(channels[0].data, fWidth * fHeight);
if channels[1] <> nil then SetLength(channels[1].data, fWidth * fHeight);
if mpFile.IsVideoChannel[2] and (channels[2] <> nil) then SetLength(channels[2].data, fWidth * fHeight);
if mpFile.IsVideoChannel[3] and (channels[3] <> nil) then SetLength(channels[3].data, fWidth * fHeight);
if mpFile.AnalogChEnabled[2] and (channels[2] <> nil) then SetLength(channels[2].data, mpFile.ChDataPtsPerFrame[2]);
if mpFile.AnalogChEnabled[3] and (channels[3] <> nil) then SetLength(channels[3].data, mpFile.ChDataPtsPerFrame[3]);
end;
constructor TFrameGroup.Create(mp_file: TMPFile);
var i: integer;
begin
mpFile := mp_file;
for i := 0 to MAX_CH - 1 do
if mpFile.VideoChEnabled[i] then
channels[i] := TVideoFrame.Create(mpFile, i, fFrameIndex)
else if mpFile.AnalogChEnabled[i] then
channels[i] := TAnalogFrame.Create(mpFile, i, fFrameIndex);
end;
constructor TFrameGroup.CreateTempFrameGroup(mp_file: TMPFile);
begin
mpFile := mp_file;
channels[0] := TVideoFrame.Create(mpFile, 0, 0);
{ SetLength(channels[0].data, width * height);}
end;
constructor TFrameGroup.CreateForOp(mp_file: TMPFile);
begin
mpFile := mp_file;
channels[0] := TVideoFrame.Create(mpFile, 0, fFrameIndex);
{ SetLength(channels[0].data, width * height);}
end;
destructor TFrameGroup.Destroy;
var i: integer;
begin
for i := 0 to MAX_CH - 1 do
channels[i].Free;
inherited Destroy;
end;
//-------------------------------- FILE OBJECT --------------------------------
//--------------------------- FILE OBJECT: PRIVATE -----------------------------
procedure TMPFile.AdjustFrameCount;
var statstg: TStatStg;
validCh: integer;
begin
if VideoChEnabled[0] then validCh := 0
else if VideoChEnabled[1] then validCh := 1
else if VideoChEnabled[2] then validCh := 2
else validCh := 3;
chStreams[validCh].Stat(statstg, STATFLAG_NONAME);
fFrameCount := statstg.cbSize div (FrameWidth * FrameHeight * SizeOf(int16));
end;
function TMPFile.GetAnalogChCount: integer;
begin
Result := 0;
if fChEnabled[2] and not fIsVideoCh[2] then Result := 1;
if fChEnabled[3] and not fIsVideoCh[3] then Result := Result + 1;
end;
function TMPFile.GetAnalogChEnabled(chIndex: integer): boolean;
begin
if (chIndex <> 2) and (chIndex <> 3) then
Result := False
else
Result := fChEnabled[chIndex] and not fIsVideoCh[chIndex];
end;
function TMPFile.GetAnalogWndCount: integer;
begin
if analogWndList <> nil then
Result := analogWndList.Count
else
Result := 0;
end;
function TMPFile.GetAnalogWnds(wndIndex: integer): TForm;
begin
Result := nil;
if (wndIndex >= 0) and (wndIndex < analogWndList.Count) then
Result := TForm(analogWndList.Items[wndIndex]);
end;
function TMPFile.GetChAcquisitionRate(chIndex: integer): double;
begin
Result := FrameRate / fChDataPtsPerFrames[chIndex];
end;
function TMPFile.GetChConvFactor(chIndex: integer): double;
begin
Result := fChConvFactors[chIndex];
end;
function TMPFile.GetChDataPtsPerFrame(chIndex: integer): integer;
begin
Result := fChDataPtsPerFrames[chIndex];
end;
function TMPFile.GetChEnabled(chIndex: integer): boolean;
begin
Result := fChEnabled[chIndex];
end;
function TMPFile.GetChInputRange(chIndex: integer): TFullScaleVal;
begin
Result := fChInputRanges[chIndex];
end;
function TMPFile.GetChMaxPixelValues(chIndex: integer): integer;
begin
Result := fChMaxPixelValues[chIndex];
end;
function TMPFile.GetChNames(chIndex: integer): string;
begin
Result := fChNames[chIndex];
end;
function TMPFile.GetChUnit(chIndex: integer): string;
begin
Result := fChUnits[chIndex];
end;
function TMPFile.GetChPrefix(chIndex: integer): TPrefix;
begin
Result := fChPrefixes[chIndex];
end;
function TMPFile.GetChOffset(chIndex: integer): double;
begin
Result := fChOffsets[chIndex];
end;
function TMPFile.GetDefaultVideoChannel: integer;
begin
if VideoChEnabled[0] then Result := 0
else if VideoChEnabled[1] then Result := 1
else if VideoChEnabled[2] then Result := 2
else Result := 3;
end;
function TMPFile.GetFrameComment(frameIndex: integer): string;
begin
Result := frameCommentList.FrameComment[frameIndex];
end;
function TMPFile.GetFrameCount: integer;
begin
if IsMemoryFile then
Result := frameGroupList.Count
else
Result := fFrameCount;
end;
function TMPFile.GetFrameRate: double; {in frames per seconds}
begin
{50 ns = 5e-8 s per pixel clock unit}
if ScanMode <> SM_REGIONSCAN then
Result := 1 / (Muldiv(5, fFrameWidth, 4) * fFrameHeight * fPixelClock * BASE_CLOCK)
else
Result := 1 / (FrameSize * fPixelClock * BASE_CLOCK);
end;
function TMPFile.GetFrameSize: integer;
begin
if ScanMode <> SM_REGIONSCAN then
Result := FrameWidth * FrameHeight
else
Result := Length(RegionPts);
end;
function TMPFile.GetFrames(frameIndex: integer): TFrameGroup;
begin
Result := nil;
if (frameIndex >= 0) and (frameIndex < FrameCount) then
if IsMemoryFile then
Result := TFrameGroup(frameGroupList.Items[frameIndex])
else
begin
ActiveFrameIndex := frameIndex;
Result := fCurrentFrameGroup;
end;
end;
{returns the size of the frame if turnaround points (20% of number of pixels in
line scans)are included}
function TMPFile.GetFullFrameSize: integer;
begin
case ScanMode of
SM_MOVIE, SM_LINESCAN, SM_STACK, SM_FASTSTACK: Result := Muldiv(5, FrameSize, 4);
else Result := FrameSize;
end;
end;
function TMPFile.GetIsVideoChannel(chIndex: integer): boolean;
begin
if (chIndex = 0) or (chIndex = 1) then
Result := True
else if (chIndex = 2) or (chIndex = 3) then
Result := fIsVideoCh[chIndex]
else
Result := False;
end;
function TMPFile.GetMaxPixelValue: integer;
begin
case fResolution of
RESOLUTION_8_BITS: Result := 255;
RESOLUTION_12_BITS: Result := DEFAULT_MAX_PIXEL_VALUE;
else Result := 32767;
end;
end;
procedure TMPFile.GetRegions;
var regionStream: IStream;
statstg: TStatStg;
regionSize: integer;
libNewPosition: Largeint;
begin
{opens the stream 'Regions'}
OleCheck(rootStorage.OpenStream('Regions', nil, RFLAGS, 0, regionStream));
{gets the size of the stream}
regionStream.Stat(statstg, STATFLAG_NONAME);
regionSize := statStg.cbSize;
OleCheck(regionStream.Seek(0, STREAM_SEEK_SET, libNewPosition));
SetLength(RegionPts, regionSize div SizeOf(TPoint));
OleCheck(regionStream.Read(@RegionPts[0], regionSize, nil));
end;
function TMPFile.GetResolution: string;
begin
case fResolution of
RESOLUTION_8_BITS: Result := '8-bit';
RESOLUTION_12_BITS: Result := '12-bit';
else Result := '16-bit';
end;
end;
function TMPFile.GetVideoChCount: integer;
begin
Result := 0;
if fChEnabled[0] then Result := 1;
if fChEnabled[1] then Result := Result + 1;
if fChEnabled[2] and fIsVideoCh[2] then Result := Result + 1;
if fChEnabled[3] and fIsVideoCh[3] then Result := Result + 1;
end;
function TMPFile.GetVideoChEnabled(chIndex: integer): boolean;
begin
if (chIndex = 0) or (chIndex = 1) then
Result := fChEnabled[chIndex]
else
Result := fChEnabled[chIndex] and fIsVideoCh[chIndex];
end;
function TMPFile.GetViewerCount: integer;
begin
Result := viewerList.Count;
end;
function TMPFile.GetViewers(viewerIndex: integer): TForm;
begin
if (viewerIndex >= 0) and (viewerIndex < viewerList.Count) then
Result := TForm(viewerList.Items[viewerIndex])
else
Result := nil;
end;
procedure TMPFile.InitializeColors;
var i: integer;
begin
baseColors[0][0] := True; {Red}
baseColors[0][1] := False;
baseColors[0][2] := False;
baseColors[1][0] := False;
baseColors[1][1] := True;
baseColors[1][2] := False;
baseColors[2][0] := False;
baseColors[2][1] := False;
baseColors[2][2] := True;
baseColors[3][0] := False;
baseColors[3][1] := True;
baseColors[3][2] := True;
negativeColors[0].rgbtRed := 0; negativeColors[0].rgbtGreen := 0; negativeColors[0].rgbtBlue := 255;
midRangeColors[0].rgbtRed := 0; midRangeColors[0].rgbtGreen := 255; midRangeColors[0].rgbtBlue := 0;
maxColors[0].rgbtRed := 255; maxColors[0].rgbtGreen := 0; maxColors[0].rgbtBlue := 0;
negativeColors[1].rgbtRed := 0; negativeColors[1].rgbtGreen := 255; negativeColors[1].rgbtBlue := 0;
midRangeColors[1].rgbtRed := 0; midRangeColors[1].rgbtGreen := 255; midRangeColors[1].rgbtBlue := 255;
maxColors[1].rgbtRed := 255; maxColors[1].rgbtGreen := 0; maxColors[1].rgbtBlue := 0;
negativeColors[2].rgbtRed := 0; negativeColors[2].rgbtGreen := 255; negativeColors[2].rgbtBlue := 0;
midRangeColors[2].rgbtRed := 0; midRangeColors[2].rgbtGreen := 255; midRangeColors[2].rgbtBlue := 255;
maxColors[2].rgbtRed := 255; maxColors[2].rgbtGreen := 0; maxColors[2].rgbtBlue := 0;
negativeColors[3].rgbtRed := 0; negativeColors[3].rgbtGreen := 255; negativeColors[3].rgbtBlue := 0;
midRangeColors[3].rgbtRed := 0; midRangeColors[3].rgbtGreen := 255; midRangeColors[3].rgbtBlue := 255;
maxColors[3].rgbtRed := 255; maxColors[3].rgbtGreen := 0; maxColors[3].rgbtBlue := 0;
for i := 0 to MAX_CH - 1 do MaxPixels[i] := 2047;
end;
procedure TMPFile.LoadFrameGroup(newIndex: integer);
begin
fCurrentFrameGroup.LoadFromFile(newIndex);
end;
type
TPropSpecArray = array[0..1000] of TPropSpec;
TPropVariantArray = array[0..1000] of TPropVariant;
TpPropSpecArray = ^TPropSpecArray;
TpPropVariantArray = ^TPropVariantArray;
function IntensityControlToString(ic: TIntensityControl): string;
begin
if ic = IC_NO_CONTROL then
Result := 'No Control'
else if ic = IC_LINEAR then
Result := 'Linear'
else
Result := 'Exponential';
end;
function StringToIntensityControl(s: string): TIntensityControl;
begin
if s = 'No Control' then
Result := IC_NO_CONTROL
else if s = 'Linear' then
Result := IC_LINEAR
else
Result := IC_EXPONENTIAL;
end;
procedure TMPFile.ReadPropertySet;
var ps: TpPropSpecArray;
pv: TpPropVariantArray;
i: integer;
s: string;
begin
ps := nil; pv := nil;
try
GetMem(ps, FILE_PROP_COUNT * SizeOf(TPropSpec));
GetMem(pv, FILE_PROP_COUNT * SizeOf(TPropVariant));
for i := 0 to FILE_PROP_COUNT - 1 do
begin
ps^[i].ulKind := PRSPEC_LPWSTR;
ps^[i].lpwstr := StringToOLEStr(sPropNames[i]);
end;
OleCheck(propertyStorage.ReadMultiple(FILE_PROP_COUNT, @ps[0], @pv[0]));
if (pv^[0].pwszVal <> nil) and (WideCharToString(pv^[0].pwszVal) = '16-bit') then
fResolution := RESOLUTION_16_BITS
else fResolution := RESOLUTION_12_BITS;
if fResolution = RESOLUTION_12_BITS then
for i := 0 to MAX_CH - 1 do fChMaxPixelValues[i] := DEFAULT_MAX_PIXEL_VALUE
else
for i := 0 to MAX_CH - 1 do fChMaxPixelValues[i] := 32767;
if pv^[1].pwszVal = nil then s := '' else
s := WideCharToString(pv^[1].pwszVal); {Scan Mode}
fScanMode := StringToScanMode(s);
{ s := WideCharToString(pv^[2].pwszVal);} {Line Scan Mode}
{ fbLineForXScan := StringToLineForXScan(s);}
if pv^[2].pwszVal = nil then s := '' else
s := WideCharToString(pv^[2].pwszVal); {X Frame Offset'}
if s = '' then s := '0'; fXFrameOffset := StrToInt(s);
if pv^[3].pwszVal = nil then s := '' else
s := WideCharToString(pv^[3].pwszVal); {Y Frame Offset'}
if s = '' then s := '0'; fYFrameOffset := StrToInt(s);
if pv^[4].pwszVal = nil then s := '' else
s := WideCharToString(pv^[4].pwszVal); {Frame Width'}
if s = '' then s := '0'; fFrameWidth := StrToInt(s);
if pv^[5].pwszVal = nil then s := '' else
s := WideCharToString(pv^[5].pwszVal); {Frame Height}
if s = '' then s := '0'; fFrameHeight := StrToInt(s);
if pv^[6].pwszVal = nil then s := '20' else
s := WideCharToString(pv^[6].pwszVal); {Pixel Clock}
if s = '' then s := '0'; fPixelClock := StrToInt(s);
if pv^[7].pwszVal = nil then fChNames[0] := 'Channel 1' else
fChNames[0] := WideCharToString(pv^[7].pwszVal); {Channel name (1)}
if pv^[8].pwszVal = nil then fChEnabled[0] := False else
fChEnabled[0] := StringToBool(WideCharToString(pv^[8].pwszVal)); {Enabled (1)}
if pv^[9].pwszVal = nil then fChInputRanges[0] := pm_10V else
fChInputRanges[0] := StringToInputRange(WideCharToString(pv^[9].pwszVal)); {Input Range (1)}
if pv^[10].pwszVal = nil then fChNames[1] := 'Channel 2' else
fChNames[1] := WideCharToString(pv^[10].pwszVal); {Channel name (2)}
if pv^[11].pwszVal = nil then fChEnabled[1] := False else
fChEnabled[1] := StringToBool(WideCharToString(pv^[11].pwszVal)); {Enabled (2)}
if pv^[12].pwszVal = nil then fChInputRanges[1] := pm_10V else
fChInputRanges[1] := StringToInputRange(WideCharToString(pv^[12].pwszVal)); {Input Range (2)}
if pv^[13].pwszVal = nil then fChNames[2] := 'Channel 3' else
fChNames[2] := WideCharToString(pv^[13].pwszVal); {Channel name (3)}
if pv^[14].pwszVal = nil then fChEnabled[2] := False else
fChEnabled[2] := StringToBool(WideCharToString(pv^[14].pwszVal)); {Enabled (3)}
if pv^[15].pwszVal = nil then fChInputRanges[2] := pm_10V else
fChInputRanges[2] := StringToInputRange(WideCharToString(pv^[15].pwszVal)); {Input Range (3)}
if pv^[16].pwszVal = nil then fChInputRanges[2] := pm_10V else
fChUnits[2] := WideCharToString(pv^[16].pwszVal); {Channel Unit (3)}
if pv^[17].pwszVal = nil then fChPrefixes[2] := tpUNITY else
fChPrefixes[2] := StringToPrefix(WideCharToString(pv^[17].pwszVal)); {Channel Prefix (3)}
if pv^[18].pwszVal = nil then s := '1' else
s := WideCharToString(pv^[18].pwszVal); {Conversion factor (3)}
if s = '' then s := '0'; fChConvFactors[2] := StrToFloat(s);
if pv^[19].pwszVal = nil then s := '' else
s := WideCharToString(pv^[19].pwszVal); {Offset (3)}
if s = '' then s := '0'; fChOffsets[2] := StrToFloat(s);
if pv^[20].pwszVal = nil then s := '' else
s := WideCharToString(pv^[20].pwszVal); {Data Points Per Frame (3)}
if s = '' then s := '0'; fChDataPtsPerFrames[2] := StrToInt(s);
if pv^[21].pwszVal = nil then fChNames[3] := 'Channel 4' else
fChNames[3] := WideCharToString(pv^[21].pwszVal); {Channel name (4)}
if pv^[22].pwszVal = nil then fChEnabled[3] := False else
fChEnabled[3] := StringToBool(WideCharToString(pv^[22].pwszVal)); {Enabled (4)}
if pv^[23].pwszVal = nil then fChInputRanges[3] := pm_10V else
fChInputRanges[3] := StringToInputRange(WideCharToString(pv^[23].pwszVal)); {Input Range (4)}
if pv^[24].pwszVal = nil then fChUnits[3] := 'V' else
fChUnits[3] := WideCharToString(pv^[24].pwszVal); {Channel Unit (4)}
if pv^[25].pwszVal = nil then fChPrefixes[3] := tpUNITY else
fChPrefixes[3] := StringToPrefix(WideCharToString(pv^[25].pwszVal)); {Channel Prefix (4)}
if pv^[26].pwszVal = nil then s := '1' else
s := WideCharToString(pv^[26].pwszVal); {Conversion factor (4)}
if s = '' then s := '0'; fChConvFactors[3] := StrToFloat(s);
if pv^[27].pwszVal = nil then s := '0' else
s := WideCharToString(pv^[27].pwszVal); {Offset (4)}
if s = '' then s := '0'; fChOffsets[3] := StrToFloat(s);
if pv^[28].pwszVal = nil then s := '0' else
s := WideCharToString(pv^[28].pwszVal); {Data Points Per Frame (4)}
if s = '' then s := '0'; fChDataPtsPerFrames[3] := StrToInt(s);
if pv^[29].pwszVal = nil then s := '1' else
s := WideCharToString(pv^[29].pwszVal); {Frame Count'}
if s = '' then s := '0'; fFrameCount := StrToInt(s);
if pv^[30].pwszVal = nil then s := '0' else
s := WideCharToString(pv^[30].pwszVal); {X Position'}
if s = '' then s := '0'; fXStagePosition := StrToInt(s);
if pv^[31].pwszVal = nil then s := '0' else
s := WideCharToString(pv^[31].pwszVal); {Y Position'}
if s = '' then s := '0'; fYStagePosition := StrToInt(s);
if pv^[32].pwszVal = nil then s := '0' else
s := WideCharToString(pv^[32].pwszVal); {Z Position'}
if s = '' then s := '0'; fZStagePosition := StrToInt(s);
if pv^[33].pwszVal = nil then s := '1' else
s := WideCharToString(pv^[33].pwszVal); {Stack Count'}
if s = '' then s := '0'; fStackFrameCount := StrToInt(s);
if pv^[34].pwszVal = nil then s := '1' else
s := WideCharToString(pv^[34].pwszVal); {z- Interval'}
if s = '' then s := '0'; fStackInterval := StrToFloat(s);
if pv^[35].pwszVal = nil then s := '1' else
s := WideCharToString(pv^[35].pwszVal); {Averaging Count'}
if s = '' then s := '0'; fStackAveragingCount := StrToInt(s);
if pv^[36].pwszVal = nil then s := '1' else
s := WideCharToString(pv^[36].pwszVal); {Repeat Count'}
if s = '' then s := '0'; fStackRepeatCount := StrToInt(s);
if pv^[37].pwszVal = nil then s := 'x1.0' else
s := WideCharToString(pv^[37].pwszVal); {Magnification - remove 'x'}
s := Copy(s, 2, Length(s) - 1); if s = '' then s := '1'; fMagnification := StrToFloat(s);
if pv^[38].pwszVal = nil then s := '0' else
s := WideCharToString(pv^[38].pwszVal); {Rotation'}
if s = '' then s := '0'; fRotation := StrToInt(s);
if pv^[39].pwszVal = nil then sComments := '' else
sComments := WideCharToString(pv^[39].pwszVal); {Comments}
if pv^[40].pwszVal = nil then fIsVideoCh[2] := False else
fIsVideoCh[2] := StringToBool(
WideCharToString(pv^[40].pwszVal)); {Is Video Channel (3)}
if pv^[41].pwszVal = nil then fIsVideoCh[3] := False else
fIsVideoCh[3] := StringToBool(
WideCharToString(pv^[41].pwszVal)); {Is Video Channel (4)}
if pv^[42].pwszVal = nil then fzDistance := 0 else
fzDistance := StrToFloat(
WideCharToString(pv^[42].pwszVal)); {z- Distance}
if pv^[43].pwszVal = nil then fTravelDuration := '0 s' else
fTravelDuration := WideCharToString(pv^[43].pwszVal); {Travel Duration}
if pv^[44].pwszVal = nil then fFastStackRepeatCount := 0 else
fFastStackRepeatCount := StrToInt(
WideCharToString(pv^[44].pwszVal)); {Fast Stack Repeat Count}
if pv^[45].pwszVal = nil then fInitialIntensity := 0 else
fInitialIntensity := StrToInt(
WideCharToString(pv^[45].pwszVal)); {Initial Intensity}
if pv^[46].pwszVal = nil then fFinalIntensity := 0 else
fFinalIntensity := StrToInt(
WideCharToString(pv^[46].pwszVal)); {Final Intensity}
if pv^[47].pwszVal = nil then fAtZDistance := 0 else
fAtZDistance := StrToFloat(
WideCharToString(pv^[47].pwszVal)); {At Z- Distance}
if pv^[48].pwszVal = nil then fIntensityControl := IC_NO_CONTROL else
fIntensityControl := StringToIntensityControl(
WideCharToString(pv^[48].pwszVal)); {Intensity Control}
for i := 0 to MAX_CH - 1 do
if pv^[49 + i].pwszVal <> nil then
try
fChMaxPixelValues[i] := StrToInt(WideCharToString(pv^[49 + i].pwszVal));
except
fChMaxPixelValues[i] := DEFAULT_MAX_PIXEL_VALUE;
end;
finally
if ps <> nil then Freemem(ps);
if pv <> nil then Freemem(pv);
end;
end;
procedure TMPFile.SetActiveFrameIndex(newIndex: integer);
begin
if (newIndex >= 0) and (newIndex < FrameCount) then
if newIndex <> fActiveFrameIndex then
begin
if not IsMemoryFile then LoadFrameGroup(newIndex);
fActiveFrameIndex := newIndex;
end;
end;
procedure TMPFile.SetFrameComment(frameIndex: integer; sComments: string);
begin
frameCommentList.FrameComment[frameIndex] := sComments;
end;
procedure TMPFile.WritePropertySet;
var ps: TpPropSpecArray;
pv: TpPropVariantArray;
i: integer;
sPropValues: array[0..FILE_PROP_COUNT - 1] of string;
begin
sPropValues[0] := Resolution;
sPropValues[1] := ScanModeToString(ScanMode); {Scan Mode}
sPropValues[2] := IntToStr(XFrameOffset); {X Frame Offset'}
sPropValues[3] := IntToStr(YFrameOffset); {Y Frame Offset'}
sPropValues[4] := IntToStr(FrameWidth); {Frame Width'}
sPropValues[5] := IntToStr(FrameHeight); {Frame Height}
sPropValues[6] := IntToStr(PixelClock); {Pixel Clock}
sPropValues[7] := ChNames[0]; {Channel name (1)}
sPropValues[8] := BoolToString(ChEnabled[0]); {Enabled (1)}
sPropValues[9] := InputRangeToString(ChInputRange[0]); {Input Range (1)}
sPropValues[10] := ChNames[1]; {Channel name (2)}
sPropValues[11] := BoolToString(ChEnabled[1]); {Enabled (2)}
sPropValues[12] := InputRangeToString(ChInputRange[1]); {Input Range (2)}
sPropValues[13] := ChNames[2]; {Channel name (3)}
sPropValues[14] := BoolToString(ChEnabled[2]); {Enabled (3)}
sPropValues[15] := InputRangeToString(ChInputRange[2]); {Input Range (3)}
sPropValues[16] := ChUnit[2]; {Channel Unit (3)}
sPropValues[17] := PrefixToString(ChPrefix[2]); {Channel Prefix (3)}
sPropValues[18] := FloatToStr(ChConvFactor[2]); {Conversion factor (3)}
sPropValues[19] := FloatToStr(ChOffset[2]); {Offset (3)}
sPropValues[20] := IntToStr(ChDataPtsPerFrame[2]); {Data Points Per Frame (3)}
sPropValues[21] := ChNames[3]; {Channel name (4)}
sPropValues[22] := BoolToString(ChEnabled[3]); {Enabled (4)}
sPropValues[23] := InputRangeToString(ChInputRange[3]); {Input Range (4)}
sPropValues[24] := ChUnit[3]; {Channel Unit (4)}
sPropValues[25] := PrefixToString(ChPrefix[3]); {Channel Prefix (4)}
sPropValues[26] := FloatToStr(ChConvFactor[3]); {Conversion factor (4)}
sPropValues[27] := FloatToStr(ChOffset[3]);{Offset (4)}
sPropValues[28] := IntToStr(ChDataPtsPerFrame[3]); {Data Points Per Frame (4)}
sPropValues[29] := IntToStr(FrameCount); {Frame Count'}
sPropValues[30] := IntToStr(XStagePosition); {X Position'}
sPropValues[31] := IntToStr(YStagePosition); {Y Position'}
sPropValues[32] := FloatToStr(ZStagePosition); {Z Position'}
sPropValues[33] := IntToStr(StackFrameCount); {Stack Count'}
sPropValues[34] := FloatToStr(StackInterval); {z- Interval'}
sPropValues[35] := IntToStr(StackAveragingCount); {Averaging Count'}
sPropValues[36] := IntToStr(StackRepeatCount); {Repeat Count'}
sPropValues[37] := 'x' + FloatToStr(Magnification); {Magnification'}
sPropValues[38] := IntToStr(Rotation); {Rotation'}
sPropValues[39] := sComments; {Comments}
sPropValues[40] := BoolToString(fIsVideoCh[2]); {Is Video Channel (3)}
sPropValues[41] := BoolToString(fIsVideoCh[3]); {s Video Channel (4)}
sPropValues[42] := FloatToStr(fzDistance); {z- Distance}
sPropValues[43] := fTravelDuration; {Travel Duration}
sPropValues[44] := IntToStr(fFastStackRepeatCount); {Fast Stack Repeat Count}
sPropValues[45] := IntToStr(fInitialIntensity); {Initial Intensity}
sPropValues[46] := IntToStr(fFinalIntensity); {Final Intensity}
sPropValues[47] := FloatToStr(fAtZDistance); {At Z- Distance}
sPropValues[48] := IntensityControlToString(fIntensityControl); {Intensity Control}
for i := 0 to MAX_CH - 1 do
sPropValues[49 + i] := IntToStr(fChMaxPixelValues[i]);
ps := nil; pv := nil;
try
GetMem(ps, FILE_PROP_COUNT * SizeOf(TPropSpec));
GetMem(pv, FILE_PROP_COUNT * SizeOf(TPropVariant));
for i := 0 to FILE_PROP_COUNT - 1 do
begin
ps^[i].ulKind := PRSPEC_LPWSTR;
ps^[i].lpwstr := StringToOLEStr(sPropNames[i]);
pv^[i].vt := VT_LPWSTR;
pv^[i].pwszVal := StringToOLEStr(sPropValues[i]);
end;
OleCheck(propertyStorage.WriteMultiple(FILE_PROP_COUNT, @ps[0], @pv[0], 2));
finally
if ps <> nil then Freemem(ps);
if pv <> nil then Freemem(pv);
end;
end;
//--------------------------- FILE OBJECT: PUBLIC ------------------------------
procedure TMPFile.AddFrameGroup(newFrameGroup: TFrameGroup);
begin
if FrameCount = 0 then
begin
{allows overriding frame width and frame height when no frame in file}
fFrameHeight := newFrameGroup.frameHeight;
fFrameWidth := newFrameGroup.frameWidth; {sets the size of the data array}
end;
if (fFrameHeight = newFrameGroup.frameHeight) and (fFrameWidth = newFrameGroup.frameWidth) then
begin
newFrameGroup.FrameIndex := FrameCount;
frameGroupList.Add(newFrameGroup);
end;
end;
procedure TMPFile.AverageFrames(chIndex, fromFrame, toFrame: integer; dest: TMPFile);
var newFrameGroup: TFrameGroup;
avgCount: integer;
avgArray: array of integer;
i, j: integer;
begin
avgCount := toFrame - fromFrame + 1;
SetLength(avgArray, FrameWidth * FrameHeight);
for i := 0 to FrameWidth * FrameHeight - 1 do avgArray[i] := 0;
newFrameGroup := TFrameGroup.CreateForOp(dest);
newFrameGroup.FrameWidth := FrameWidth;
newFrameGroup.FrameHeight := FrameHeight;
for j := fromFrame to toFrame do
for i := 0 to FrameWidth * FrameHeight - 1 do
avgArray[i] := avgArray[i] + Frames[j].channels[chIndex].data[i];
for i := 0 to FrameWidth * FrameHeight - 1 do
newFrameGroup.channels[0].data[i] := avgArray[i] div avgCount;
dest.AddFrameGroup(newFrameGroup);
end;
procedure TMPFile.BinaryOp(file1, file2: TMPFile; ch1, ch2, frame1, frame2: integer; gain1, gain2: double;
resultFrame: integer);
var i, j: integer;
dblOpResult: double;
iOpResult: int16;
frame1Obj, frame2Obj, resultFrameObj: TVideoFrame;
begin
frame1Obj := file1.Frames[frame1].channels[ch1] as TVideoFrame;
frame2Obj := file2.Frames[frame2].channels[ch2] as TVideoFrame;
resultFrameObj := Frames[resultFrame].channels[0] as TVideoFrame;
for j := 0 to FrameHeight - 1 do
for i := 0 to FrameWidth - 1 do
begin
dblOpResult := gain1 * frame1Obj.Pixels[i, j] + gain2 * frame2Obj.Pixels[i, j];
if dblOpResult > DEFAULT_MAX_PIXEL_VALUE then
iOpResult := DEFAULT_MAX_PIXEL_VALUE
else if dblOpResult < -DEFAULT_MAX_PIXEL_VALUE - 1 then
iOpResult := -DEFAULT_MAX_PIXEL_VALUE - 1
else
iOpResult := Round(dblOpResult);
resultFrameObj.data[i + j * FrameWidth] := iOpResult;
end;
OnNewFrames;
end;
procedure TMPFile.Close(Sender: TObject);
var i: integer;
begin
fbClosing := True;
{closes all the windows}
if ViewerCount > 0 then
for i := 0 to ViewerCount - 1 do
Viewers[i].Close;
if AnalogWndCount > 0 then
for i := 0 to AnalogWndCount - 1 do
AnalogWnds[i].Close;
Free;
end;
function TMPFile.CreateEmptyFrame(fromFile: TMPFile): integer;
var newFrameGroup: TFrameGroup;
begin
newFrameGroup := TFrameGroup.CreateForOp(self);
newFrameGroup.FrameWidth := fromFile.FrameWidth;
newFrameGroup.FrameHeight := fromFile.FrameHeight;
AddFrameGroup(newFrameGroup);
Result := FrameCount - 1;
OnNewFrames; {update each time we project - looks nicer!}
end;
procedure TMPFile.CopyChannelsToClipboard(bCh2, bCh3: boolean; fromFrame, toFrame: integer);
type TCharArray = array[0..Maxint div 2 - 1] of WideChar;
var chIndex, rowCount, frameIndex, sampleIndex: integer;
timeVal, sampleVal: double;
memhandle: THandle;
pString: ^TCharArray;
swLength, stringindex,maxcharcount: integer;
s1: string;
sw: array[0..179] of WideChar;
begin
if not(bCh2 or bCh3) then Exit;
if bCh2 then chIndex := 2 else chIndex := 3;
rowCount := (toFrame - fromFrame + 1) * ChDataPtsPerFrame[chIndex];
if rowCount <= 65536 then
begin
Clipboard.Open;
Clipboard.Clear;
try
{fills string with data; 11 digits for each column - each digit is a wide char, 2 columns}
{number of rows is (toFrame - fromFrame + 1) * ChDataPtsPerFrame[]}
{frameIndex: 0 to toFrame - fromFrame}
{time in ms for each frame: (fromFrame + frameIndex) * FrameSize * PixelClock * 1e-6 }
{sampleIndex: 0 to ChDataPtsPerFrame[] - 1}
{for each sample: sampleIndex * FrameSize * PixelClock * 1e-6 / ChDataPtsPerFrame[]}
maxcharcount := SizeOf(WideChar)* (
(2 {columns} * 20 {20 digits} + 3 {Tab, CR, LF}) * rowCount
+ 1 {Null}
); {wide char}
memHandle := GlobalAlloc(
GMEM_MOVEABLE or GMEM_DDESHARE or GMEM_ZEROINIT,
maxcharcount);
if memHandle <> 0 then
begin
pString := GlobalLock(memHandle);
stringindex := 0;
for frameIndex := 0 to toFrame - fromFrame do
begin
ActiveFrameIndex := fromFrame + frameIndex;
for sampleIndex := 0 to ChDataPtsPerFrame[chIndex]- 1 do
begin
timeVal := 1000 * (sampleIndex / ChDataPtsPerFrame[chIndex] + fromFrame + frameIndex) / FrameRate;
{timeVal in ms; pixel clock is in increments of 50 ns = 5e-5 ms(20 MHz)}
{ timeVal := (FrameSize * PixelClock * 5e-5) *
(sampleIndex / ChDataPtsPerFrame[chIndex] + fromFrame + frameIndex);}
{sampleVal}
sampleVal := ChConvFactor[chIndex] * FullScaleToVal(ChInputRange[chIndex]) *
Frames[ActiveFrameIndex].channels[chIndex].data[sampleIndex] /
(f_MAX_Y_VALUE + 1) + ChOffset[chIndex];
s1 := Format('%.6f', [timeVal]) + TAB + Format('%g', [sampleVal]) + CRLF;
swLength := Length(s1);
StringToWideChar(s1, @sw, SizeOf(WideChar) * (swLength + 1));
if stringIndex < maxcharcount div 2 - swLength then
begin
Move(sw[0], pString^[stringIndex], SizeOf(WideChar) * swLength);
stringIndex := stringIndex + swLength; {points to the next character}
end;
end;
end;
Clipboard.SetAsHandle(CF_UNICODETEXT, memHandle);
end
else
MessageDlg('Insufficient memory to export data; try saving data to disk as text file.' + CRLF +
'(Menu: File\Save\Analog Data As...)', mtError, [mbOK], 0);
finally
Clipboard.Close;
end;
end {rowcount <= }
else
MessageDlg('Too many data samples to export; try saving data to disk as text file.' + CRLF +
'(Menu: File\Save\Analog Data As...)', mtError, [mbOK], 0);
end;
procedure TMPFile.CopyFrames(chIndex, fromFrame, toFrame: integer; dest: TMPFile); {from one file to a memory file, rect to rect}
var newFrameGroup: TFrameGroup;
i, j: integer;
begin
for j := fromFrame to toFrame do
begin
newFrameGroup := TFrameGroup.CreateForOp(dest);
newFrameGroup.FrameWidth := FrameWidth;
newFrameGroup.FrameHeight := FrameHeight;
for i := 0 to FrameWidth * FrameHeight - 1 do
newFrameGroup.channels[0].data[i] := Frames[j].channels[chIndex].data[i];
dest.AddFrameGroup(newFrameGroup);
end;
end;
procedure TMPFile.CloneROIs(ROIList: TROIList; fromIndex: integer); {duplicate each ROI but with opposite channel}
var i, j, oldCount, chIndex: integer;
oldROI, newROI: TSimpleROI;
begin
with ROIList do
if fromIndex <= Count - 1 then
begin
oldCount := Count;
for i := fromIndex to oldCount - 1 do
begin
oldROI := TSimpleROI(Items[i]);
for chIndex := 0 to MAX_CH - 1 do
if IsVideoChannel[chIndex] and (oldROI.Channel <> chIndex) then
begin
if oldROI is TRectangularROI then
begin
newROI := TRectangularROI.Create;
(newROI as TRectangularROI).roiRect := (oldROI as TRectangularROI).roiRect;
end
else if oldROI is TEllipticalROI then
begin
newROI := TEllipticalROI.Create;
(newROI as TEllipticalROI).roiRect := (oldROI as TEllipticalROI).roiRect;
(newROI as TEllipticalROI).FindPixels;
end
else
begin
newROI := TObjectROI.Create;
if oldROI.PixelCount > 0 then
for j := 0 to oldROI.PixelCount - 1 do
(newROI as TObjectROI).AddPt(oldROI.Pixels[j]);
end;
newROI.fChannel := chIndex;
newROI.fROIIndex := ROIList.Count + 1;
Add(newROI);
end;
end;
end;
end;
const
ALREADY_SCANNED = -32768;
procedure TMPFile.DetectROIs(ROIList: TROIList; chIndex, fromFrame, toFrame, threshold, minArea,
templateFrom, templateTo: integer);
var tempFrameGroup: TFrameGroup;
i, j: integer;
objectROI: TObjectROI;
avgCount: integer;
avgArray: array of integer;
{nested recursive procedure to find ROI in all adjacent points}
procedure FindROIObject(i, j: integer; var aROIObject: TObjectROI);
var pixelValue: int16;
begin
if (i < 0) or (i >= FrameWidth) or (j < 0) or (j >= FrameHeight) then Exit;
pixelValue := tempFrameGroup.channels[0].data[j * FrameWidth + i];
if pixelValue >= threshold then
begin
tempFrameGroup.channels[0].data[j * FrameWidth + i] := ALREADY_SCANNED;
if aROIObject = nil then
begin
aROIObject := TObjectROI.Create;
aROIObject.fChannel := chIndex;
aROIObject.fROIIndex := ROIList.Count + 1;
end;
aROIObject.AddPt(Point(i, j));
FindROIObject(i - 1, j - 1, aROIObject);
FindROIObject(i , j - 1, aROIObject);
FindROIObject(i + 1, j - 1, aROIObject);
FindROIObject(i - 1, j , aROIObject);
FindROIObject(i + 1, j , aROIObject);
FindROIObject(i - 1, j + 1, aROIObject);
FindROIObject(i , j + 1, aROIObject);
FindROIObject(i + 1, j + 1, aROIObject);
end;
end;
begin
// create a temporary frame group
tempFrameGroup := TFrameGroup.CreateTempFrameGroup(self);
tempFrameGroup.FrameWidth := FrameWidth;
tempFrameGroup.FrameHeight := FrameHeight;
// average frames from templateFrom to templateTo onto tempFrameGroup
avgCount := templateTo - templateFrom + 1;
SetLength(avgArray, FrameWidth * FrameHeight);
for i := 0 to FrameWidth * FrameHeight - 1 do avgArray[i] := 0;
for j := templateFrom to templateTo do
for i := 0 to FrameWidth * FrameHeight - 1 do
avgArray[i] := avgArray[i] + Frames[j].channels[chIndex].data[i];
for i := 0 to FrameWidth * FrameHeight - 1 do
tempFrameGroup.channels[0].data[i] := avgArray[i] div avgCount;
// search for objects in tempFrameGroup recursively
for j := 0 to FrameHeight - 1 do
for i := 0 to FrameWidth - 1 do
begin
objectROI := nil;
FindROIObject(i, j, objectROI);
{we found a new object}
if objectROI <> nil then
ROIList.Add(objectROI);
end;
// clean up; we eliminate all ObjectROIs that are not large enough
if ROIList.Count > 0 then
for i := ROIList.Count - 1 downto 0 do
if ROIList.ROIs[i] is TObjectROI then
if (ROIList.ROIs[i] as TObjectROI).PixelCount < minArea then
ROIList.Delete(i);
tempFrameGroup.Free;
end;
function TMPFile.DigitalToAnalog(chIndex, iValue: integer): double;
begin
Result := ChOffset[chIndex] + ChConvFactor[chIndex] * FullScaleToVal(ChInputRange[chIndex]) *
(iValue / (MaxPixelValue + 1));
end;
procedure TMPFile.DoBackgroundCorrection;
var ch, i, j, pixelIndex: integer;
pixelVal, minValue: int16;
begin
if FrameCount = 0 then Exit;
for ch := 0 to MAX_CH - 1 do
if VideoChEnabled[ch] then
begin
minValue := 32767;
for i := 0 to FrameWidth - 1 do
for j := 0 to FrameHeight - 1 do
begin
pixelVal := Frames[ActiveFrameIndex].channels[ch].data[i + j * FrameWidth];
if pixelVal < minValue then minValue := pixelVal;
end;
if minValue < 0 then
for i := 0 to FrameWidth - 1 do
for j := 0 to FrameHeight - 1 do
begin
pixelIndex := i + j * FrameWidth;
pixelVal := Frames[ActiveFrameIndex].channels[ch].data[pixelIndex];
pixelVal := pixelVal - minValue;
Frames[ActiveFrameIndex].channels[ch].data[pixelIndex] := pixelVal;
end;
end;
end;
function TMPFile.GetAverage(frameIndex, chIndex: integer; rc: TRect): integer;
var i, j: integer;
begin
Result := 0;
for i := rc.Left to rc.Right do
for j := rc.Top to rc.Bottom do
Result := Result + Frames[frameIndex].channels[chIndex].data[i + j * FrameWidth];
Result := Result div ((rc.Right - rc.Left + 1) * (rc.Bottom - rc.Top + 1));
end;
function TMPFile.GetMax(frameIndex, chIndex: integer; rc: TRect; var x, y: integer): integer;
var pixelVal, i, j: integer;
begin
Result := -32768;
for i := rc.Left to rc.Right do
for j := rc.Top to rc.Bottom do
begin
pixelVal := Frames[frameIndex].channels[chIndex].data[i + j * FrameWidth];
if pixelVal > Result then
begin
Result := pixelVal;
x := i;
y := j;
end;
end;
end;
function TMPFile.GetMin(frameIndex, chIndex: integer; rc: TRect; var x, y: integer): integer;
var pixelVal, i, j: integer;
begin
Result := 32768;
for i := rc.Left to rc.Right do
for j := rc.Top to rc.Bottom do
begin
pixelVal := Frames[frameIndex].channels[chIndex].data[i + j * FrameWidth];
if pixelVal < Result then
begin
Result := pixelVal;
x := i;
y := j;
end;
end;
end;
function TMPFile.GetROIAverageValue(ROIList: TROIList; roiIndex, frameIndex: integer): integer;
var i, j: integer;
theROI: TSimpleROI;
roiPixel: TPoint;
begin
Result := 0;
theROI := ROIList.ROIs[roiIndex];
for i := 0 to theROI.PixelCount - 1 do
begin
roiPixel := theROI.Pixels[i];
j := roiPixel.x + roiPixel.y * FrameWidth;
Result := Result + Frames[frameIndex].channels[theROI.Channel].data[j];
end;
Result := Result div theROI.PixelCount;
end;
function TMPFile.GetPixelValue(frameIndex, chIndex, xData, yData: integer): int16;
begin
Result := 0;
if (frameIndex >= 0) and (frameIndex < FrameCount) and IsVideoChannel[chIndex]
and (xData >= 0) and (xData < FrameWidth) and (yData >= 0)
and (yData < FrameHeight) then
Result := Frames[frameIndex].channels[chIndex].data[xData + yData * FrameWidth];
end;
function TMPFile.GetPropertyValue(propName: string): string;
var ps: TpPropSpecArray;
pv: TpPropVariantArray;
begin
ps := nil; pv := nil;
try
GetMem(ps, SizeOf(TPropSpec));
GetMem(pv, SizeOf(TPropVariant));
ps^[0].ulKind := PRSPEC_LPWSTR;
ps^[0].lpwstr := StringToOLEStr(propName);
try
OleCheck(propertyStorage.ReadMultiple(1, @ps[0], @pv[0]));
Result := WideCharToString(pv^[0].pwszVal);
except
Result := 'No match';
end;
finally
if ps <> nil then Freemem(ps);
if pv <> nil then Freemem(pv);
end;
end;
function TMPFile.IsOperationOK(chIndex, fromFrame, toFrame: integer; dest: TMPFile): boolean;
begin
Result := ChEnabled[chIndex] and (fromFrame >= 0) and (fromFrame < FrameCount) and (toFrame >= 0) and
(toFrame < FrameCount) and (fromFrame <= toFrame) and dest.IsMemoryFile;
end;
type EAVIError = class(Exception);
TRGBTripleArray = array[0..Maxint div 8] of TRGBTriple;
TpRGBTripleArray = ^TRGBTripleArray;
procedure TMPFile.MakeAVIMovie(const avifilename: string; chIndex, fromFrame, toFrame, newframeRate: integer;
colorScheme: TColorScheme; fromViewer: TObject; bOverlayCh1on2: boolean);
var aviFile: IAVIFile;
aviStream: IAVIStream;
bitmapInfo: TBITMAPINFO;
pAviBitmap: TpRGBTripleArray;
spCharFileName: array[0..255] of WideChar;
spCharStreamName: array[0..63] of WideChar;
streamInfo: TAVIStreamInfo;
i, j, k, maxPixVal: integer;
pixel0, pixel1: TRGBTriple;
hr: HResult;
const sStreamName = '2-photon laser confocal microscope video stream';
begin
maxPixVal := ChMaxPixelValues[chIndex]; {caching value}
if AVIFileOpen(aviFile,
StringToWideChar(aviFilename, @spCharFileName, 255),
OF_CREATE or OF_SHARE_EXCLUSIVE or OF_WRITE, nil) <> 0 then
raise EAVIError.Create('Error in creating AVI file');
FillChar(streamInfo, SizeOf(streamInfo), 0);
StringToWideChar(sStreamName, @spCharStreamName, 63);
with streamInfo do
begin
fccType := streamtypeVIDEO;
fccHandler := 0;
dwScale := 1;
dwRate := Round(newframeRate);
if dwRate > 24 then dwRate := 24; // bound to 24 fps
dwSuggestedBufferSize := FrameWidth * FrameHeight;
rcFrame := Rect(0, 0, FrameWidth - 1, FrameHeight - 1);
for i := 0 to 63 do
szName[i] := spCharStreamName[i];
end;
if AVIFileCreateStream(aviFile, aviStream, streamInfo) <> 0 then
raise EAVIError.Create('Cannot create AVI stream');
FillChar(bitmapInfo, SizeOf(TBITMAPINFO), 0);
with bitmapInfo.bmiHeader do
begin
biSize := SizeOf(TBITMAPINFOHEADER);
biWidth := FrameWidth;
biHeight := FrameHeight; // we invert bitmap in the loop
biPlanes := 1;
biBitCount := 24;
biCompression := BI_RGB;
end;
if AVIStreamSetFormat(aviStream, 0, @bitmapInfo, SizeOf(TBITMAPINFOHEADER)) <> 0 then
raise EAVIError.Create('Cannot set format of video stream');
GetMem(pAviBitmap, FrameHeight * FrameWidth * SizeOf(TRGBTriple));
i := fromFrame;
repeat
for j := 0 to FrameHeight * FrameWidth - 1 do
begin
k := Frames[i].Channels[chIndex].data[j];
if k < 0 then k := 0;
k := Muldiv(k, maxPixVal, MAX_FALSE_COLORS - 1);
if k > MAX_FALSE_COLORS - 1 then k := MAX_FALSE_COLORS - 1;
case colorScheme of
CS_GRAYSCALE: pAviBitmap^[j] := Mainform.grayScaleTable[k];
CS_FALSECOLORS: pAviBitmap^[j] := Mainform.falseColorTable[k];
CS_CUSTOMLUT: pAviBitmap^[j] := (fromViewer as TViewerFrm).mpFile.CustomColors[chIndex][k];
end;
{Overlay Ch1 on Ch2}
if bOverlayCh1on2 and (chIndex = 1) and VideoChEnabled[0] then
begin
pixel1 := pAviBitmap^[j];
{pixel for Ch1 (index of 0)}
k := Frames[i].Channels[0].data[j];
if k < 0 then k := 0;
k := Muldiv(k, maxPixVal, MAX_FALSE_COLORS - 1);
if k > MAX_FALSE_COLORS - 1 then k := MAX_FALSE_COLORS - 1;
case colorScheme of
CS_GRAYSCALE: pixel0 := Mainform.grayScaleTable[k];
CS_FALSECOLORS: pixel0 := Mainform.falseColorTable[k];
CS_CUSTOMLUT: pixel0 := (fromViewer as TViewerFrm).mpFile.CustomColors[0][k];
end;
pixel1.rgbtBlue := pixel1.rgbtBlue or pixel0.rgbtBlue;
pixel1.rgbtGreen := pixel1.rgbtGreen or pixel0.rgbtGreen;
pixel1.rgbtRed := pixel1.rgbtRed or pixel0.rgbtRed;
pAviBitmap^[j] := pixel1;
end;
end;
hr := AVIStreamWrite(aviStream, i - fromFrame, 1, pAviBitmap,
FrameWidth * FrameHeight * SizeOf(TRGBTriple), AVIIF_KEYFRAME, nil, nil);
i := i + 1;
until not Succeeded(hr) or (i > toFrame);
Freemem(pAviBitmap, FrameHeight * FrameWidth * SizeOf(TRGBTriple) );
{instead of using the AVI API functions to release the stream and file,
we do it the Delphi way by making them nil}
aviStream := nil;
aviFile := nil;
if not Succeeded(hr) then
raise EAVIError.Create('Error writing frame to file');
end;
function TMPFile.MakeTIFF(const avifilename: string; chIndex, fromFrame, toFrame: integer): boolean;
var Stream : TFileStream;
i, j, k, l, sLength, maxPixVal: integer;
pixelValue: int16;
wPixelValues: array of Word;
videoFrame: TFrame;
ifd: TIFD;
sImageDescription: string;
begin
Result := True;
maxPixVal := ChMaxPixelValues[chIndex]; {just caching this value}
Stream := TFileStream.Create(avifilename, fmCreate Or fmShareExclusive);
try
sImageDescription := Format(sTIFFPropNames, [
chIndex + 1,
Resolution,
ScanModeToString(ScanMode),
XStagePosition,
YStagePosition,
ZStagePosition,
StackFrameCount,
StackInterval,
StackAveragingCount,
StackRepeatCount,
Magnification,
Rotation,
XFrameOffset,
YFrameOffset,
FrameRate ]);
{Write TIFF file header}
Stream.Write(tiffHeader, SizeOf(tiffHeader));
{Write the IFDs}
MakeIFD(ifd);
sLength := Length(sImageDescription) + 1; {includes the NULL finishing the string}
with ifd do
begin
tagRecords[22].Count := sLength;
tagRecords[2].dataOffset := FrameWidth;
tagRecords[3].dataOffset := FrameHeight;
tagRecords[12].dataOffset := FrameHeight; {RowsPerStrip}
tagRecords[13].dataOffset := FrameHeight * FrameWidth * SizeOf(Word); {StripByteCounts}
end;
for i := fromFrame to toFrame do
with ifd do
begin
{XResolution}
ifd.tagRecords[16].dataOffset := SizeOf(tiffHeader) + (i - fromFrame + 1) * (SizeOf(ifd) + sLength)
- 4 * SizeOf(integer) - sLength;
{YResolution}
ifd.tagRecords[17].dataOffset := SizeOf(tiffHeader) + (i - fromFrame + 1) * (SizeOf(ifd) + sLength)
- 2 * SizeOf(integer) - sLength;
{ImageDescription}
ifd.tagRecords[22].dataOffset := SizeOf(tiffHeader) + (i - fromFrame + 1) * (SizeOf(ifd) + sLength)
- sLength;
{StripOffsets}
ifd.tagRecords[9].dataOffset := SizeOf(tiffHeader) + (toFrame - fromFrame + 1) * (SizeOf(ifd) + sLength) +
FrameWidth * FrameHeight * SizeOf(Word) * (i - fromFrame);
if i <> toFrame then
nextIDFoffset := SizeOf(tiffHeader) + (i - fromFrame + 1) * (SizeOf(ifd) + sLength)
else
nextIDFoffset := 0;
Stream.Write(ifd, SizeOf(ifd));
{Write the description string}
Stream.Write(sImageDescription[1], sLength);
end;
{Write frame data for each frame}
SetLength(wPixelValues, FrameHeight * FrameWidth);
for i := fromFrame to toFrame do
begin
videoFrame := Frames[i].Channels[chIndex];
for j := 0 to FrameHeight - 1 do
begin
for k := 0 to FrameWidth - 1 do
begin
l := j * FrameWidth + k;
pixelValue := videoFrame.data[l];
{truncate value and normalize to 0..65535}
if pixelValue < 0 then
begin
wPixelValues[l] := 0;
Result := False;
end
else
wPixelValues[l] := Muldiv(pixelValue, 65535, maxPixVal);
end;
end;
Stream.Write(wPixelValues[0], FrameHeight * FrameWidth * SizeOf(Word));
end;
finally
Stream.Free;
end;
end;
procedure TMPFile.NewAnalogWnd;
var analogFrm: TAnalogFrm;
begin
analogFrm := TAnalogFrm.Create(Mainform);
analogFrm.Initialize(self);
analogFrm.Show;
analogWndList.Add(analogFrm);
analogFrm.FormResize(nil); {forces painting}
end;
procedure TMPFile.NewViewer;
var viewerFrm: TViewerFrm;
begin
viewerFrm := TViewerFrm.Create(Mainform);
viewerFrm.Initialize(self, viewerList.Add(viewerFrm) + 1);
viewerFrm.CurrentFrameIndex := 0;
viewerFrm.Show;
end;
procedure TMPFile.OnNewFrames;
var i: integer;
begin
if FrameCount <= 0 then Exit;
if viewerList.Count > 0 then
for i := 0 to viewerList.Count - 1 do
TViewerFrm(viewerList.Items[i]).CurrentFrameIndex := FrameCount - 1;
end;
procedure TMPFile.OnWndClose(wnd: TForm); {when a viewer or analog wnd closes}
var i: integer;
begin
if not Closing and not Mainform.bAppClosing then
if AnalogWndCount + ViewerCount = 1 then
{the last window standing for this file: if we close, file object is free}
Free
else
begin
if analogWndList <> nil then
begin
i := analogWndList.IndexOf(wnd);
if i >= 0 then analogWndList.Remove(wnd);
end;
i := viewerList.IndexOf(wnd);
if i >= 0 then viewerList.Remove(wnd);
end;
end;
procedure TMPFile.SaveChannelsToFile(bASCII: boolean; fname: string; bCh2, bCh3: boolean; fromFrame, toFrame: integer);
var chIndex, frameIndex, sampleIndex: integer;
timeVal, sampleVal: double;
fileStream: TFileStream;
swLength: integer;
s1: string;
sw: array[0..179] of WideChar;
begin
if not(bCh2 or bCh3) then Exit;
if bCh2 then chIndex := 2 else chIndex := 3;
fileStream := TFileStream.Create(fname, fmCreate or fmShareExclusive);
try
fileStream.Seek(0, soFromBeginning);
{fills string with data; 11 digits for each column - each digit is a wide char, 2 columns}
{number of rows is (toFrame - fromFrame + 1) * ChDataPtsPerFrame[]}
{frameIndex: 0 to toFrame - fromFrame}
{time in ms for each frame: (fromFrame + frameIndex) * FrameSize * PixelClock * 1e-6 }
{sampleIndex: 0 to ChDataPtsPerFrame[] - 1}
{for each sample: sampleIndex * FrameSize * PixelClock * 1e-6 / ChDataPtsPerFrame[]}
for frameIndex := 0 to toFrame - fromFrame do
begin
ActiveFrameIndex := fromFrame + frameIndex;
for sampleIndex := 0 to ChDataPtsPerFrame[chIndex]- 1 do
begin
timeVal := (sampleIndex / ChDataPtsPerFrame[chIndex] + fromFrame + frameIndex) / FrameRate;
{timeVal in s; pixel clock is in increments of 50 ns = 5e-5 ms(20 MHz)}
{ timeVal := (FrameSize * PixelClock * 5e-5) *
(sampleIndex / ChDataPtsPerFrame[chIndex] + fromFrame + frameIndex);}
{sampleVal}
sampleVal := ChConvFactor[chIndex] * FullScaleToVal(ChInputRange[chIndex]) *
Frames[ActiveFrameIndex].channels[chIndex].data[sampleIndex] /
(f_MAX_Y_VALUE + 1) + ChOffset[chIndex];
s1 := Format('%.6f', [timeVal]) + TAB + Format('%g', [sampleVal]) + CRLF;
if bASCII then
fileStream.Write(s1[1], Length(s1))
else
begin
swLength := 2 * Length(s1); {Unicode business}
StringToWideChar(s1, @sw, swLength + 1);
fileStream.Write(sw, swLength);
end;
end;
end;
finally
fileStream.Free;
end;
end;
procedure TMPFile.StackX(chIndex, fromFrame, toFrame, fromY, toY: integer; dest: TMPFile);{creates new frame}
var newFrameGroup: TFrameGroup;
i, j, k: integer;
value: int16;
pDataElt: ^int16;
begin
newFrameGroup := TFrameGroup.CreateForOp(dest);
newFrameGroup.FrameWidth := FrameWidth;
newFrameGroup.FrameHeight := toFrame - fromFrame + 1;
dest.AddFrameGroup(newFrameGroup);
for i := fromFrame to toFrame do
begin
ActiveFrameIndex := i;
for j := 0 to FrameWidth - 1 do
begin
pDataElt := @(newFrameGroup.Channels[0].data[(i - fromFrame) * FrameWidth + j]);
pDataElt^ := 0;
for k := fromY to toY do
begin
value := Frames[ActiveFrameIndex].channels[chIndex].data[k * FrameWidth + j];
if value > DEFAULT_MAX_PIXEL_VALUE then value := DEFAULT_MAX_PIXEL_VALUE;
if value > pDataElt^ then pDataElt^ := value;
end;
end;
dest.OnNewFrames; {update each time we project - looks nicer!}
end;
end;
function TMPFile.SizeOfFrameCompatible(width, height: integer): boolean;
begin
if FrameCount = 0 then
Result := True
else
if (width = FrameWidth) and (height = FrameHeight) then
Result := True
else
begin
MessageDlg( 'Operation not possible.' + CRLF +
'Destination workspace has different frame size.',
mtError, [mbOK], 0);
Result := False;
end;
end;
procedure TMPFile.StackY(chIndex, fromFrame, toFrame, fromX, toX: integer; dest: TMPFile);
var newFrameGroup: TFrameGroup;
i, j, k: integer;
value: int16;
pDataElt: ^int16;
begin
newFrameGroup := TFrameGroup.CreateForOp(dest);
newFrameGroup.FrameWidth := FrameHeight;
newFrameGroup.FrameHeight := toFrame - fromFrame + 1;
dest.AddFrameGroup(newFrameGroup);
for i := fromFrame to toFrame do
begin
ActiveFrameIndex := i;
for j := 0 to FrameHeight - 1 do
begin
pDataElt := @newFrameGroup.Channels[0].data[(i - fromFrame) * FrameHeight + j];
pDataElt^ := 0;
for k := fromX to toX do
begin
value := Frames[ActiveFrameIndex].channels[chIndex].data[j * FrameWidth + k];
if value > DEFAULT_MAX_PIXEL_VALUE then value := DEFAULT_MAX_PIXEL_VALUE;
if value > pDataElt^ then pDataElt^ := value;
end;
end;
dest.OnNewFrames; {update each time we project - looks nicer!}
end;
end;
procedure TMPFile.StackZ(chIndex, fromFrame, toFrame: integer; dest: TMPFile);
var newFrameGroup: TFrameGroup;
i, j, k: integer;
value: int16;
pDataElt: ^int16;
begin
newFrameGroup := TFrameGroup.CreateForOp(dest);
newFrameGroup.FrameWidth := FrameWidth;
newFrameGroup.FrameHeight := FrameHeight;
for i := 0 to FrameWidth * FrameHeight - 1 do
newFrameGroup.Channels[0].data[i] := 0;
dest.AddFrameGroup(newFrameGroup);
for i := fromFrame to toFrame do
begin
ActiveFrameIndex := i;
for j := 0 to FrameHeight - 1 do
for k := 0 to FrameWidth - 1 do
begin
pDataElt := @newFrameGroup.Channels[0].data[j * FrameWidth + k];
value := Frames[ActiveFrameIndex].channels[chIndex].data[j * FrameWidth + k];
if value > DEFAULT_MAX_PIXEL_VALUE then value := DEFAULT_MAX_PIXEL_VALUE;
if value > pDataElt^ then pDataElt^ := value;
end;
dest.OnNewFrames; {update each time we project - looks nicer!}
end;
end;
function TMPFile.SaveAs(const sFilename: string): TFileErr;
var hr: HResult;
i: integer;
begin
// create the file on disk
hr := StgCreateDocFile(StringToOLEStr(sFilename), OFLAGS, 0, rootStorage);
if Succeeded(hr) then
begin
propertySetStorage := rootStorage as IPropertySetStorage;
propertySetStorage.Create(FMTID_User_Defined_Properties,
FMTID_User_Defined_Properties, PROPSETFLAG_DEFAULT, OFLAGS, propertyStorage);
rootStorage.SetClass(GUID_MPD);
// save user information
WritePropertySet;
frameCommentList.SaveFrameComments;
// change status of file and filename
fFilename := sFilename;
fbIsMemoryFile := False;
fFrameCount := frameGroupList.Count;
// opens the channels
OLECheck(rootStorage.CreateStream('Ch0', OFLAGS, 0, 0, chStreams[0]));
// save the frame list
for i := 0 to frameGroupList.Count - 1 do
(TFrameGroup(frameGroupList.Items[i]).channels[0] as TVideoFrame).SaveToFile;
// create the current frame group (at frame Index 0)
fActiveFrameIndex := 0;
fCurrentFrameGroup := TFrameGroup(frameGroupList.Items[0]);
// destroys the frame list (except first frame at index 0)
if frameGroupList.Count> 1 then
for i := 1 to frameGroupList.Count - 1 do
TFrameGroup(frameGroupList.Items[i]).Free;
frameGroupList.Free;
frameGroupList := nil;
Result := feOK;
// notify all the viewers as the name change
if viewerList.Count > 0 then
for i := 0 to viewerList.Count - 1 do
TForm(viewerList.Items[i]).Caption := 'Video Channels - ' +
ExtractFileName(fFilename);
end
else
Result := StgErrToFileErr(hr);
end;
procedure TMPFile.SubtractFrame(chIndex, plusFrameIndex, minusFrameIndex: integer; dest: TMPFile);
var newFrameGroup: TFrameGroup;
i: integer;
value, minValue: int16;
begin
newFrameGroup := TFrameGroup.CreateForOp(dest);
newFrameGroup.FrameWidth := FrameWidth;
newFrameGroup.FrameHeight := FrameHeight;
for i := 0 to FrameWidth * FrameHeight - 1 do
newFrameGroup.channels[0].data[i] := Frames[plusFrameIndex].channels[chIndex].data[i];
minValue := DEFAULT_MAX_PIXEL_VALUE;
for i := 0 to FrameWidth * FrameHeight - 1 do
begin
value := newFrameGroup.channels[0].data[i] - Frames[minusFrameIndex].channels[chIndex].data[i];
if value < minValue then minValue := value;
if value > DEFAULT_MAX_PIXEL_VALUE then value := DEFAULT_MAX_PIXEL_VALUE;
newFrameGroup.channels[0].data[i] := value;
end;
{bring minimal pixel level to 0}
if minValue < 0 then
for i := 0 to FrameWidth * FrameHeight - 1 do
begin
value := newFrameGroup.channels[0].data[i] - minValue;
if value > DEFAULT_MAX_PIXEL_VALUE then value := DEFAULT_MAX_PIXEL_VALUE;
newFrameGroup.channels[0].data[i] := value;
end;
dest.AddFrameGroup(newFrameGroup);
end;
constructor TMPFile.CreateFromTemplate(const sFilename: string; templateFile: TMPFile);
var i: integer;
begin
{a worskpace file has always one video channel and no analog channel}
fResolution := templateFile.fResolution;
fActiveFrameIndex := -1;
fAngle := templateFile.Angle;
fbIsMemoryFile := True;
fChEnabled[0] := True;
fChEnabled[1] := False;
fChEnabled[2] := False;
fChEnabled[3] := False;
for i := 0 to MAX_CH - 1 do
begin
fChConvFactors[i] := templateFile.ChConvFactor[i];
fChDataPtsPerFrames[i] := templateFile.ChDataPtsPerFrame[i];
fChInputRanges[i] := templateFile.ChInputRange[i];
fChNames[i] := templateFile.ChNames[i];
fChPrefixes[i] := templateFile.ChPrefix[i];
fChUnits[i] := templateFile.ChUnit[i];
fChOffsets[i] := templateFile.ChOffset[i];
fIsVideoCh[i] := False;
fChMaxPixelValues[i] := templateFile.ChMaxPixelValues[i];
end;
fFilename := sFilename;
fFrameCount := 0;
fFrameHeight := templateFile.FrameHeight;
fFrameWidth := templateFile.FrameWidth;
fLineRepeatCount := templateFile.LineRepeatCount;
fMagnification := templateFile.Magnification;
fPixelClock := templateFile.PixelClock;
fRotation := templateFile.Rotation;
fScanMode := SM_MOVIE; {a workspace is always a movie}
fStackAveragingCount := templateFile.LineRepeatCount;
fStackFrameCount := templateFile.StackFrameCount;
fStackInterval := templateFile.StackInterval;
fStackRepeatCount := templateFile.StackRepeatCount;
fXFrameOffset := templateFile.XFrameOffset;
fXStagePosition := templateFile.XStagePosition;
fYFrameOffset := templateFile.YFrameOffset;
fYStagePosition := templateFile.YStagePosition;
fZStagePosition := templateFile.ZStagePosition;
{color information here}
baseColors := templateFile.baseColors;
negativeColors := templateFile.negativeColors;
midRangeColors := templateFile.midRangeColors;
maxColors := templateFile.maxColors;
MaxPixels := templateFile.MaxPixels;
frameCommentList := TFrameCommentList.Create(self);
frameGroupList := TList.Create;
bDirty := False;
viewerList := TList.Create;
NewViewer;
end;
constructor TMPFile.CreateFromFile(const sFilename: string);
var i: integer;
hr: HResult;
begin
{opens the storage}
InitializeColors;
hr := StgOpenStorage(StringToOLEStr(sFilename), nil, RFLAGS, nil, 0, rootStorage);
if Succeeded(hr) then
begin
propertySetStorage := rootStorage as IPropertySetStorage;
if not Succeeded(propertySetStorage.Open(FMTID_User_Defined_Properties,
RFLAGS, propertyStorage)) then MessageDlg('Cannot open property set', mtError, [mbOK], 0);
ReadPropertySet;
for i := 0 to MAX_CH - 1 do
if chEnabled[i] then
rootStorage.OpenStream(StringToOleStr('Ch' + IntToStr(i)), nil, RFLAGS,
0, chStreams[i]);
AdjustFrameCount;
fFilename := sFilename;
if ScanMode = SM_REGIONSCAN then GetRegions;
fCurrentFrameGroup := TFrameGroup.Create(self);
fActiveFrameIndex := -1; ActiveFrameIndex := 0; {forces loading}
frameCommentList := TFrameCommentList.Create(self);
frameCommentList.LoadFrameComments;
viewerList := TList.Create;
NewViewer;
if (AnalogChCount > 0) and (ScanMode <> SM_STACK) and (ScanMode <> SM_FASTSTACK) then
{just to be on the safe side, if the analog streams are empty, we bail}
if (chStreams[2] <> nil) or (chStreams[3] <> nil) then
begin
analogWndList := TList.Create;
NewAnalogWnd;
end;
end
else
MessageDlg(FileErrToStr(StgErrToFileErr(hr)), mtError, [mbOK], 0);
end;
destructor TMPFile.Destroy;
var i: integer;
begin
fCurrentFrameGroup.Free;
frameGroupList.Free;
if analogWndList <> nil then
begin
if analogWndList.Count > 0 then
for i := 0 to analogWndList.Count - 1 do
begin
TAnalogFrm(analogWndList.Items[i]).mpFile := nil;
TAnalogFrm(analogWndList.Items[i]).Close;
if Mainform.bAppClosing then Application.ProcessMessages;
end;
analogWndList.Free;
end;
{a lot of Windows voodoo here - why it seems to work beats me}
if viewerList.Count > 0 then
for i := 0 to viewerList.Count - 1 do
begin
TViewerFrm(viewerList.Items[i]).mpFile := nil;
TViewerFrm(viewerList.Items[i]).Close;
if Mainform.bAppClosing then Application.ProcessMessages;
end;
viewerList.Free;
frameCommentList.Free;
{ for i := 0 to MAX_CH - 1 do channels[i] := nil;}
propertyStorage := nil;
propertySetStorage := nil;
rootStorage := nil;
Mainform.FileList.NotifyFileClosing(self);
end;
{********************************* TFileList **********************************}
{------------------------------- TFileList: private ---------------------------}
function TFileList.IsMPFile(const sFilename: string): boolean;
{var clsid: TCLSID;}
begin
{ Result := False;}
{if Succeeded(StgIsStorageFile(StringToOLEStr(sFilename)) then}
{ if Succeeded(GetClassFile(StringToOLEStr(sFilename), clsid)) then
Result := IsEqualGUID(clsid, GUID_MPD);}
Result := True;
end;
function TFileList.GetTemporaryFileName: string;
var i: integer;
begin
i := 1;
Result := 'Workspace ' + IntToStr(i);
while IndexOf(Result) >= 0 do
begin
i := i + 1;
Result := 'Workspace ' + IntToStr(i);
end;
end;
function TFileList.Load(const sFilename: string): TFileErr;
begin
if not IsMPFile(sFilename) then
Result := feNotAMPFile
else if IndexOf(sFilename) >= 0 then
Result := feFileAlreadyOpen
else
begin
AddObject(sFilename, TMPFile.CreateFromFile(sFilename));
Result := feOK;
end;
end;
{------------------------------- TFileList: public ---------------------------}
procedure TFileList.FillComboBoxWithWorkspaces(aComboBox: TComboBox);
var i: integer;
begin
aComboBox.Clear;
if Count > 0 then
begin
for i := 0 to Count - 1 do
if TMPFile(Objects[i]).IsMemoryFile then
aComboBox.Items.AddObject(TMPFile(Objects[i]).Filename, Objects[i]);
if aComboBox.Items.Count > 0 then aComboBox.ItemIndex := 0;
end;
end;
procedure TFileList.NewFile(templateFile: TMPFile);
var tempFileName: string;
begin
tempFileName := GetTemporaryFileName;
AddObject(tempFileName, TMPFile.CreateFromTemplate(tempFileName, templateFile));
end;
procedure TFileList.NotifyFileClosing(Sender: TMPFile);
var i: integer;
begin
if not Mainform.bAppClosing then
begin
i := IndexOfObject(Sender);
if i >= 0 then Delete(i);
end;
end;
function TFileList.WorkspaceCount: integer;
var i: integer;
begin
Result := 0;
if Count > 0 then
for i := 0 to Count - 1 do
if TMPFile(Objects[i]).IsMemoryFile then Result := Result + 1;
end;
procedure TFileList.SaveFileAs(mpFile: TMPFile; const newName: string);
var i: integer;
fe: TFileErr;
begin
i := IndexOfObject(mpFile);
if i >= 0 then
if TMPFile(Objects[i]).IsMemoryFile then
begin
fe := TMPFile(Objects[i]).SaveAs(newName);
if fe = feOK then
{swaps names}
Strings[i] := newName
else
MessageDlg('Cannot save ' + Strings[i] + ' as' + CRLF +
newName + CRLF +
FileErrToStr(fe), mtError, [mbOK], 0);
end;
end;
procedure TFileList.Open(const sFilename: string);
var fe: TFileErr;
begin
if IndexOf(sFilename) >= 0 then
MessageDlg(Format(sAlreadyLoaded, [sFilename]), mtInformation, [mbOK], 0)
else
begin
fe := Load(sFilename);
if fe <> feOK then
MessageDlg(FileErrToStr(fe), mtError, [mbOK], 0)
else
dataDirectory := ExtractFilePath(sFilename);
end;
end;
destructor TFileList.Destroy;
var i: integer;
begin
if Count > 0 then
for i := 0 to Count - 1 do
TMPFile(Objects[i]).Free;
inherited Destroy;
end;
end.
Raw
MP Unit
unit MPUnit;
interface
uses Forms, Registry, Graphics, Windows, SysUtils, Classes, Messages, StdCtrls, ActiveX,
ComObj;
const
MAX_CH = 4; {4 AI channels in National Instruments PCI-6110E}
DEFAULT_DEVICE_INDEX = 3; {PCI-6110E multifunction board index}
DEFAULT_SHUTTER_DEVICE_INDEX = 2; {PCI-6711 I/O board controlling the shutter}
BASE_CLOCK = 5e-8; {50 ns base clock = 20 MHz clock frequency}
PCI_6110E = 241; {code for the PCI-6110E}
PCI_6711_1 = 261; // channel one
PCI_6711_2 = 262; //channel two
PCI_6711_3 = 263; // channel three
PCI_6711_4 = 264; // channel four
{the GUID for multiphoton data files}
GUID_MPD: TGUID = '{5BC02769-74F0-47DF-929E-2E5D3630D9B5}';
CR = Chr(10) {+ Chr(13)};
TAB = Chr(9);
type
int16 = Smallint;
int32 = Integer;
TWaveformArray = array[0..1,0..MaxInt div 8] of int16;
TpWaveform = ^TWaveformArray;
TDigitalWaveform = array[0..MaxInt div 4] of int16;
TpDigitalWaveform = ^TDigitalWaveform;
TFrameData = array[0..MaxInt div 4] of int16;
TpFrameData = ^TFrameData;
TPrecision = (PREC_8_BIT, PREC_10_BIT, PREC_12_BIT, PREC_14_BIT, PREC_16_BIT);
TDisplayMode = (DM_RECORDING, DM_ANALYZING);
TTimeValue = int64; {all times in ns}
TFullScaleVal = (pm_42V, pm_20V, pm_10V, pm_5V, pm_2V, pm_1V, pm_0_5V, pm_0_2V);
TInputRange = Set Of TFullScaleVal;
TPrefix = ( tpXENNO, tpYOCTO, tpZEPTO, tpATTO, tpFEMTO, tpPICO, tpNANO,
tpMICRO, tpMILLI, tpUNITY, tpKILO, tpMEGA, tpGIGA, tpTERA, tpPETA,
tpECTA, tpZETTA, tpYOTTA, tpXENNA, tpZERO, tpNONE );
TPhysVal = record
value: double;
prefix: integer; {index in the StringList of prefix}
end;
TPhysValue = record
value: double;
defaultPrefix: TPrefix;
physUnit: string[15];
end;
TTimeVal = record
value: double;
prefix: integer; {index in the StringList of prefix}
end;
TScanMode = (SM_MOVIE, SM_STACK, SM_STACKMOVIE, SM_LINESCAN, SM_REPEAT_LINESCAN);
TStopScanMode = (SSM_OK, SSM_USER, SSM_FRAME_COUNT_REACHED, SSM_DATAOVERRUN, SSM_DISKERROR);
TStopStimMode = (SSTM_USER, SSTM_SCAN_STOPPED);
TConfigRecord = record
scanMode: TScanMode;
stackCount,
XFrameOffset,
YFrameOffset,
FrameWidth,
FrameHeight,
PixelClock: integer;
zInterval : double;
ChConvFactors: array[0..MAX_CH -1] of double;
ChDataPtsPerFrames: array[0..MAX_CH -1] of integer;
ChEnabled: array[0..MAX_CH - 1] of boolean;
ChInputRanges: array[0..MAX_CH - 1] of TFullScaleVal;
ChNames: array[0..MAX_CH - 1] of string[32];
ChOffsets: array[0..MAX_CH -1] of double;
ChPrefixes: array[0..MAX_CH -1] of TPrefix;
ChUnits: array[0..MAX_CH - 1] of string[32];
end;
TConfiguration = class
private
bDirty: boolean;
sConfigName: string;
fXFrameOffset,
fYFrameOffset,
fFrameWidth,
fFrameHeight,
fPixelClock {in increments of 50 ns (= 20 MHz)}: integer;
fScanMode: TScanMode;
fChConvFactors: array[0..MAX_CH -1] of double;
fChDataPtsPerFrames: array[0..MAX_CH -1] of integer;
fChEnabled: array[0..MAX_CH - 1] of boolean;
fChInputRanges: array[0..MAX_CH - 1] of TFullScaleVal;
fChNames: array[0..MAX_CH - 1] of string;
fChOffsets: array[0..MAX_CH -1] of double;
fChPrefixes: array[0..MAX_CH -1] of TPrefix;
fChUnits: array[0..MAX_CH - 1] of string;
procedure DefaultConfig;
function GetAnalogChCount: integer;
function GetFrameRate: double;
function GetChAnalogFreqs(chIndex: integer): double;
function GetChConvFactors(chIndex: integer): double;
function GetChCount: integer;
function GetChDataPtsPerFrames(chIndex: integer): integer;
function GetChEnabled(chIndex: integer): boolean;
function GetChInputRanges(chIndex: integer): TFullScaleVal;
function GetChNames(chIndex: integer): string;
function GetChOffsets(chIndex: integer): double;
function GetChPrefixes(chIndex: integer): TPrefix;
function GetChUnits(chIndex: integer): string;
function GetFullFrameWidth: integer;
function GetVideoChCount: integer;
procedure SetChConvFactors(chIndex: integer; newconvfactor: double);
procedure SetChDataPtsPerFrames(chIndex: integer; newDataPtsPerFrames: integer);
procedure SetChEnabled(chIndex: integer; newChEnabled: boolean);
procedure SetChInputRanges(chIndex: integer; newChInputRanges: TFullScaleVal);
procedure SetChNames(chIndex: integer; newChNames: string);
procedure SetChOffsets(chIndex: integer; newChOffsets: double);
procedure SetChPrefixes(chIndex: integer; newChPrefixes: TPrefix);
procedure SetChUnits(chIndex: integer; newChUnits: string);
procedure SetFrameHeight(newHeight: integer);
procedure SetFrameRate(newRate: double);
procedure SetFrameWidth(newWidth: integer);
procedure SetPixelClock(newClockRate: integer);
procedure SetScanMode(newMode: TScanMode);
procedure SetXFrameOffset(newXOffset: integer);
procedure SetYFrameOffset(newYOffset: integer);
public
stackCount: integer;
zInterval: double;
function AnalogToDigitalValue(chIndex: integer; analogVal: double): integer;
procedure CopyTo(var configRecord: TConfigRecord);
function DigitalToAnalogValue(chIndex: integer; digitalVal: integer): double;
procedure GetMaxFrameRate(iframeWidth, iFrameHeight: integer; var newFrameRate: double;
var newPixelRate: integer);
procedure OpenConfiguration(const fname: string);
procedure RestoreFrom(const configRecord: TConfigRecord);
procedure SaveConfiguration(const fname: string);
function PixelRateToFrameRate(newPixelRate, iframeWidth, iframeHeight: integer; var newFrameRate: double): boolean;
function FrameRateToPixelRate(newFrameRate: double; iframeWidth, iframeHeight: integer; var newPixelRate: integer): boolean;
constructor Create;
property AnalogChCount: integer read GetAnalogChCount;
property ChAnalogFreqs[chIndex: integer]: double read GetChAnalogFreqs;
property ChConvFactors[chIndex: integer]: double read GetChConvFactors write SetChConvFactors;
property ChCount: integer read GetChCount;
property ChDataPtsPerFrames[chIndex: integer]: integer read GetChDataPtsPerFrames write SetChDataPtsPerFrames;
property ChEnabled[chIndex: integer]: boolean read GetChEnabled write SetChEnabled;
property ChInputRanges[chIndex: integer]: TFullScaleVal read GetChInputRanges write SetChInputRanges;
property ChNames[chIndex: integer]: string read GetChNames write SetChNames;
property ChOffsets[chIndex: integer]: double read GetChOffsets write SetChOffsets;
property ChPrefixes[chIndex: integer]: TPrefix read GetChPrefixes write SetChPrefixes;
property ChUnits[chIndex: integer]: string read GetChUnits write SetChUnits;
property Filename: string read sConfigName;
property FrameHeight: integer read fFrameHeight write SetFrameHeight;
property FrameWidth: integer read fFrameWidth write SetFrameWidth; {linear portion of the scan}
property FrameRate: double read GetFrameRate write SetFrameRate;
property FullFrameWidth: integer read GetFullFrameWidth; {includes sine wave rounded portion}
property Modified: boolean read bDirty;
property PixelClock: integer read fPixelClock write SetPixelClock;
property ScanMode: TScanMode read fScanMode write SetScanMode;
property VideoChCount: integer read GetVideoChCount;
property XFrameOffset: integer read fXFrameOffset write SetXFrameOffset;
property YFrameOffset: integer read fYFrameOffset write SetYFrameOffset;
end;
{The class to handle *.MPD data files. Parameters are stored in the
#5UserDefinedProperties stream, including comments}
TMPFile = class
private
bDirty: boolean;
sFileName: string;
rootStorage: IStorage;
streams: array[0..3] of IStream;
fPropertyStorage: IPropertyStorage;
fPropertySetStorage: IPropertySetStorage;
public
function DefaultFileName(const fileDir: string): string;
procedure Close(sComments: string);
procedure NewFile(const sNewFile: string);
{SetProperties stores config info and creates streams}
procedure SetProperties(const config: TConfiguration);
function Write(streamIndex: integer; var data; cbytes: integer): boolean;
constructor Create(const sInitialDir: string);
property Dirty: boolean read bDirty;
property Filename: string read sFileName;
end;
{*****************************************************************************}
{* FILES *}
{*****************************************************************************}
TFileErr = (feOK,
feCannotFindFile,
fePathNotFound,
feTooManyFilesOpened,
feAccessDenied,
feBadFileType,
feBadVersion,
feForceConversion,
feDiskFull,
feFileIsNotStorage,
feOutOfMemory,
feBadDiskDrive,
feCannotReadFile,
feUnknownError,
feBadData,
feUnexpectedEOF,
feShareViolation,
feInvalidHandle,
feFileNotAssigned,
feFileNotOpen,
feFileNotOpenForInput,
feFileNotOpenForOutput,
feInvalidInput,
feInvalidName,
feNotAPXDFile
);
TStorageNameErr = (sneOK, sneInvalidName, sneTooLong, sneInvalidChar, sneNumChar,
sneReservedName, sneAlreadyExists);
//******************************** GRAPHICS *********************************
TMinMaxPt = record
MaxPt, MinPt: TPoint;
end;
TTrace = array of TMinMaxPt;
TpTrace = ^TTrace;
//*************************** REGION OF INTEREST ****************************
TSimpleROI = class
procedure Draw(aCanvas: TCanvas; magnification: integer); virtual;
end;
TRectangleROI = class(TSimpleROI)
public
rc: TRect;
procedure Draw(aCanvas: TCanvas; magnification: integer); override;
end;
TEllipseROI = class(TSimpleROI)
public
ellipse: TRect; {the bounding rectangle of the ellipse}
procedure Draw(aCanvas: TCanvas; magnification: integer); override;
end;
TPolygonROI = class(TSimpleROI)
public
polygon: array of TPoint;
procedure Draw(aCanvas: TCanvas; magnification: integer); override;
end;
{When an ROI has been defined (by adding simple ROIs), the client should:
Call GetPixelCount once: this returns the number of pixels in the ROI and
resets the enumeration
Call repetitively NextPtInROI; When NextPtInROI returns False, the
enumerator is reset}
TROI = class(TList)
private
rectCount,
rectIndex,
i, j: integer;
regionRects: array of TRect;
handleRGN: HRGN;
function GetSimpleROIs(index: integer): TSimpleROI;
function GetPixelCount: integer; {caches the rectangles}
public
function AddSimpleROI(Item: TSimpleROI): integer;
function NextPtInROI(var pt: TPoint): boolean;
procedure Draw(aCanvas: TCanvas; magnification: integer);
destructor Destroy; override;
property SimpleROIs[index: integer]: TSimpleROI read GetSimpleROIs;
property PixelCount: integer read GetPixelCount;
end;
// ============================ Registry Methods ===============================
function StrParse(var fullStr: string; delim: Char): string;
procedure SavePosToRegistry(aForm: TForm; regini: TRegistryIniFile; const section, entry: string);
procedure RestorePosFromRegistry(aForm: TForm; regini: TRegistryIniFile; const section, entry: string;
bMainForm: boolean);
{*****************************************************************************}
{* Transfer functions *}
{*****************************************************************************}
{calculates the offset of a data point in a buffer at time int64Time}
function TimeToPoint(int64Time, int64TimeBase, int64TimeStamp: TTimeValue): integer;
{reverse function}
function PointToTime(pointPos: integer; int64TimeBase, int64TimeStamp: TTimeValue): TTimeValue;
function PrefixToString(prefix: TPrefix): string;
function PrefixToFactor(prefix: TPrefix): double;
function ExpToPrefixString(exponent: integer): string;
function GetPrefixFromValue(value: double): TPrefix;
procedure TimeValToUser(timeval: TTimeValue; var value: double; var prefix: integer);
function TimeValToString(timeval: TTimeValue): string;
function SizeOfSample(dataType: TVartype): integer;
function TimeToFreqString(aTime: TTimeValue {in ns}): string; {Hz, kHz, MHz}
{*****************************************************************************}
{* List Box Functions *}
{*****************************************************************************}
{this procedure initializes a list box with prefixes and unit}
procedure FillUnitListBox(listBox: TComboBox; sUnit: string);
{this function returns the index of the prefix in a list box filled with prefix-unit}
function UnitPrefixToListBoxIndex(prefix: integer): integer;
function ListBoxIndexToUnitPrefix(listBoxIndex: integer): integer;
procedure FillTimeListBox(listBox: TComboBox); {fill a list box with ns, us, etc...}
procedure AbsoluteTimeToTimePrefix(absTime: TTimeValue; var dblTime: double; var timeIndex: integer);
{timeIndex corresponds to a value in a list box}
function ListBoxIndexToTimePrefix(listBoxIndex: integer): TTimeValue;
procedure FillInputRangeListBox(listBox: TComboBox); {fill a list box with ns, us, etc...}
function InputRangeToString(inputRange: TFullScaleVal): string;
{*****************************************************************************}
{* Axis Label Functions *}
{*****************************************************************************}
{timeval is a time interval; returns a decade (in us...); used for time major tick
marks }
function TimeIntervalDecade(timeval: TTimeValue): TTimeValue;
function FullScaleToVal(fs: TFullScaleVal): double;
// ============================ File I/O Methods ===============================
function IOErrToFileErr(code: integer): TFileErr;
function FileErrToStr(fe: TFileErr): string;
function StgErrToFileErr(hr: HResult): TFileErr;
// ============================ Miscellaneous ==================================
function FindCommonRegion(start1, end1, start2, end2: integer;
var commonStart, commonEnd: integer): boolean;
procedure NormalizeRect(var rect: TRect);
function PrecisionToString(aPrecision: TPrecision): string;
function PointStrictlyInRect(const aPt: TPoint; aRect: TRect): boolean;
function ScanModeToString(smode: TScanMode): string;
procedure MakeRectFromPts(left, top, right, bottom: integer; var rectarray: array of TPoint);
{******************************************************************************}
{*} {*}
{*} IMPLEMENTATION {*}
{*} {*}
{******************************************************************************}
uses Math, inifiles, Dialogs;
resourcestring
// FILE I/O ERRORS
sIOErr_FileNotFound = 'File not found';
sIOErr_PathNotFound = 'Path not found';
sIOErr_TooManyOpenFiles = 'Too many open files';
sIOErr_AccessDenied = 'File access denied';
sIOErr_InvalidHandle = 'Invalid file handle';
sIOErr_NotEnoughMemory = 'Insufficient memory for this operation';
sIOErr_InvalidFileAccessCode = 'Invalid file access code';
sIOErr_InvalidData = 'Invalid data';
sIOErr_NotEnoughStorage = 'Not enough storage';
sIOErr_InvalidDrive = 'Invalid drive';
sIOErr_CannotWrite = 'Error writing to file';
sIOErr_CannotRead = 'Error reading from file';
sIOErr_SharingViolation = 'Share violation error';
sIOErr_EOF = 'Disk read error, read past end of file';
sIOErr_DiskFull = 'Disk write error, disk full';
sIOErr_FileNotAssigned = 'File not assigned';
sIOErr_NotACompoundFile = 'Invalid file';
sIOErr_InvalidName = 'Invalid file name';
sIOErr_Unexpected = 'Unexpected error';
sIOErr_InvalidFileType = 'Invalid file type';
sIOErr_InvalidVersion = 'Invalid file version';
sIOErr_FileIsNotStorage = 'The file is not a compound file';
sIOErr_BadData = 'Corrupted data in file';
sIOErr_ForceConversion = 'Forced file conversion';
sIOErr_FileNotOpen = 'File not opened';
sIOErr_FileNotOpenForInput = 'File not opened for input';
sIOErr_FileNotOpenForOutput = 'File not opened for output';
sIOErr_InvalidInput = 'Invalid input';
sIOErr_NotAPXDFile = 'The file is not a PXD file';
// Storage name error
sSNE_InvalidName = 'Invalid name';
sSNE_TooLong = 'Name too long';
sSNE_InvalidChar = 'Invalid character in name';
sSNE_NumChar = 'Invalid numerical character in name';
sSNE_ReservedName = 'Reserved name';
sSNE_AlreadyExist = 'Name already exists';
type
EMPConfig = class(Exception);
TPropSpecArray = array[0..1000] of TPropSpec;
TpPropSpecArray = ^TPropSpecArray;
TPropVariantArray = array[0..1000] of TPropVariant;
TpPropVariantArray = ^TPropVariantArray;
TStatPropStgArray = array[0..1000] of TStatPropStg;
TpStatPropStgArray = ^TStatPropStgArray;
const
FMTID_User_Defined_Properties: TGUID = '{D5CDD505-2E9C-101B-9397-08002B2CF9AE}';
function PrecisionToString(aPrecision: TPrecision): string;
begin
case aPrecision of
PREC_8_BIT: Result := '8-bit';
PREC_10_BIT: Result := '10-bit';
PREC_12_BIT: Result := '12-bit';
PREC_14_BIT: Result := '14-bit';
else Result := '16-bit';
end;
end;
procedure MakeRectFromPts(left, top, right, bottom: integer; var rectarray: array of TPoint);
begin
rectarray[0].x := left; rectarray[0].y := top;
rectarray[1].x := right; rectarray[1].y := top;
rectarray[2].x := right; rectarray[2].y := bottom;
rectarray[3].x := left; rectarray[3].y := bottom;
rectarray[4].x := left; rectarray[4].y := top;
end;
// ============================ Registry Methods ===============================
function StrParse(var fullStr: string; delim: Char): string;
var delimPos: integer;
begin
delimPos := Pos(delim, fullStr);
if delimPos > 0 then
begin
Result := Copy(fullStr,1,Pred(delimPos));
fullStr := Copy(fullStr,Succ(delimPos),Length(fullStr));
end
else
Result := fullStr;
end;
procedure SavePosToRegistry(aForm: TForm; regini: TRegistryIniFile; const section, entry: string);
var buffer: array[0..79] of Char;
windowPlacement: TWindowPlacement;
begin
windowPlacement.Length := SizeOf(windowPlacement);
GetWindowPlacement(aForm.Handle, @windowPlacement);
WVSPrintf(buffer, '%i,%i,%i,%i,%i,%i,%i,%i,%i,%i,%i', @windowPlacement);
regini.WriteString(section, entry, StrPas(buffer));
end;
procedure RestorePosFromRegistry(aForm: TForm; regini: TRegistryIniFile; const section, entry: string;
bMainForm: boolean);
var buffer: string;
windowPlacement: TWindowPlacement;
begin
buffer := regini.ReadString(section, entry, '');
FillChar(windowPlacement, SizeOf(windowPlacement), 0);
windowPlacement.Length := SizeOf(windowPlacement);
if buffer <> '' then
begin
StrToIntDef(StrParse(buffer, ','), 0);
with windowPlacement do
begin
flags := StrToInt(StrParse(buffer, ','));
showCmd := StrToInt(StrParse(buffer, ','));
ptMinPosition.x := StrToInt(StrParse(buffer, ','));
ptMinPosition.y := StrToInt(StrParse(buffer, ','));
ptMaxPosition.x := StrToInt(StrParse(buffer, ','));
ptMaxPosition.y := StrToInt(StrParse(buffer, ','));
rcNormalPosition.Left := StrToInt(StrParse(buffer, ','));
rcNormalPosition.Top := StrToInt(StrParse(buffer, ','));
rcNormalPosition.Right := StrToInt(StrParse(buffer, ','));
rcNormalPosition.Bottom := StrToInt(StrParse(buffer, ','));
case ShowCmd of
sw_showMinimized,
sw_showminnoactive,
sw_minimize:
aForm.WindowState := wsMinimized;
sw_showmaximized:
aForm.WindowState := wsMaximized;
end;
end;
SetWindowPlacement(aForm.Handle, @windowPlacement);
end
else
if bMainForm then
with windowPlacement do
begin
showCmd := SW_SHOW;
if not SystemParametersInfo(SPI_GETWORKAREA, 0, @rcNormalPosition, 0) then
rcNormalPosition := Rect(0, 0, 799, 599);
SetWindowPlacement(aForm.Handle, @windowPlacement);
end;
end;
{*****************************************************************************}
{* Transfer functions *}
{*****************************************************************************}
function PrefixToString(prefix: TPrefix): string;
begin
case prefix of
tpXENNO: Result := 'x';
tpYOCTO: Result := 'y';
tpZEPTO: Result := 'z';
tpATTO: Result := 'a';
tpFEMTO: Result := 'f';
tpPICO: Result := 'p';
tpNANO: Result := 'n';
tpMICRO: Result := #181;
tpMILLI: Result := 'm';
tpUNITY : Result := '';
tpKILO: Result := 'k';
tpMEGA: Result := 'M';
tpGIGA: Result := 'G';
tpTERA: Result := 'T';
tpPETA: Result := 'P';
tpECTA: Result := 'E';
tpZETTA: Result := 'Z';
tpYOTTA: Result := 'Y';
tpXENNA: Result := 'X';
tpNONE: Result := '';
else
Result := '';
end;
end;
function PrefixToFactor(prefix: TPrefix): double;
begin
case prefix of
tpXENNO: Result := 1E-27;
tpYOCTO: Result := 1E-24;
tpZEPTO: Result := 1E-21;
tpATTO: Result := 1E-18;
tpFEMTO: Result := 1E-15;
tpPICO: Result := 1E-12;
tpNANO: Result := 1E-9;
tpMICRO: Result := 1E-6;
tpMILLI: Result := 1E-3;
tpUNITY : Result := 1;
tpKILO: Result := 1E+3;
tpMEGA: Result := 1E+6;
tpGIGA: Result := 1E+9;
tpTERA: Result := 1E+12;
tpPETA: Result := 1E+15;
tpECTA: Result := 1E+18;
tpZETTA: Result := 1E+21;
tpYOTTA: Result := 1E+24;
tpXENNA: Result := 1E+27;
tpNONE: Result := 1;
else
Result := 1;
end;
end;
function ExpToPrefixString(exponent: integer): string;
begin
case exponent of
-27: Result := 'x';
-24: Result := 'y';
-21: Result := 'z';
-18: Result := 'a';
-15: Result := 'f';
-12: Result := 'p';
-9: Result := 'n';
-6: Result := #181;
-3: Result := 'm';
0 : Result := '';
3: Result := 'k';
6: Result := 'M';
9: Result := 'G';
12: Result := 'T';
15: Result := 'P';
18: Result := 'E';
21: Result := 'Z';
24: Result := 'Y';
27: Result := 'X';
else
Result := '';
end;
end;
{This function chooses the most appropriate prefix for the value
if value is too small, returns tpZERO}
function GetPrefixFromValue(value: double): TPrefix;
begin
value := Abs(value);
if value <= 1E-30 then
Result := tpZERO
else if value < 1E-24 then
Result := tpXENNO
else if value < 1E-21 then
Result := tpYOCTO
else if value < 1E-18 then
Result := tpZEPTO
else if value < 1E-15 then
Result := tpATTO
else if value < 1E-12 then
Result := tpFEMTO
else if value < 1E-9 then
Result := tpPICO
else if value < 1E-6 then
Result := tpNANO
else if value < 1E-3 then
Result := tpMICRO
else if value < 1E-0 then
Result := tpMILLI
else if value < 1E+3 then
Result := tpUNITY
else if value < 1E+6 then
Result := tpKILO
else if value < 1E+9 then
Result := tpMEGA
else if value < 1E+12 then
Result := tpGIGA
else if value < 1E+15 then
Result := tpTERA
else if value < 1E+18 then
Result := tpPETA
else if value < 1E+21 then
Result := tpECTA
else if value < 1E+24 then
Result := tpZETTA
else if value < 1E+27 then
Result := tpYOTTA
else if value < 1E+30 then
Result := tpXENNA
else
Result := tpXENNA;
end;
function SizeOfSample(dataType: TVartype): integer;
begin
case dataType of
VT_I2: Result := SizeOf(int16);
VT_I4: Result := SizeOf(int32);
VT_R4: Result := SizeOf(single);
VT_R8: Result := SizeOf(double);
VT_UI2: Result := SizeOf(int16); {12-bit integer}
else
Result := SizeOf(int16);
end;
end;
{! in a buffer, a time stamp is always > than any time, i.e. the time stamp is the
time of the last point pushed in the buffer}
function TimeToPoint(int64Time, int64TimeBase, int64TimeStamp: TTimeValue): integer;
begin
TimeToPoint := (int64TimeStamp - int64Time)div int64TimeBase;
end;
function PointToTime(pointPos: integer; int64TimeBase, int64TimeStamp: TTimeValue): TTimeValue;
begin
PointToTime := int64TimeStamp - pointPos * int64TimeBase;
end;
procedure TimeValToUser(timeval: TTimeValue; var value: double; var prefix: integer);
begin
if timeval = 0 then
begin
value := 0;
prefix := 0;
end
else if Abs(timeval) >= Round(1e09) then
begin
value := timeval div Round(1e09);
prefix := 0;
end
else if Abs(timeval) >= Round(1e06) then
begin
value := timeval div Round(1e06);
prefix := -3; {ms}
end
else if Abs(timeval) >= Round(1e03) then
begin
value := timeval div Round(1e03);
prefix := -6; {us}
end
end;
function TimeValToString(timeval: TTimeValue): string;
var cDays, cHours, cMin: integer;
nSec: double;
fmtTimeStr: string[63];
begin
if timeval = 0 then
Result := '0s'
else
try
if Abs(timeval) > Round(1e09) then
begin
if Abs(timeval) > Round(24 * 60 * 60 * 1e09) then
begin
cDays := Abs(Timeval) div Round(24 * 60 * 60 * 1e09);
cHours := (Abs(Timeval) - cDays * Round(24 * 60 * 60 * 1e09)) div Round(60 * 60 * 1e09);
cMin := (Abs(Timeval) - cDays * Round(24 * 60 * 60 * 1e09) - cHours * Round(60 * 60 * 1e09)) div Round(60 * 1e09);
nSec := (Abs(Timeval) - cDays * Round(24 * 60 * 60 * 1e09) - cHours * Round(60 * 60 * 1e09) - cMin * Round(60 * 1e09)) / Round(1e09);
if cDays > 1 then fmtTimeStr := '%ddays' else fmtTimeStr := '%dday';
if cHours > 1 then fmtTimeStr := fmtTimeStr + ' %dhrs %dmin %.5ds'
else fmtTimeStr := fmtTimeStr + ' %dhr %dmin %.5ds';
result := Format(fmtTimeStr , [cDays, cHours, cMin, nSec]);
if timeVal < 0 then result := '- ' + Result;
end
else if Abs(timeval) > Round(60 * 60 * 1e09) then
begin
cHours := Abs(Timeval) div Round(60 * 60 * 1e09);
cMin := (Abs(Timeval) - cHours * Round(60 * 60 * 1e09)) div Round(60 * 1e09);
nSec := (Abs(Timeval) - cHours * Round(60 * 60 * 1e09) - cMin * Round(60 * 1e09)) div Round(1e09);
if cHours > 1 then fmtTimeStr := '%dhrs %dmin %.5ds'
else fmtTimeStr := '%dhr %dmin %.5ds';
result := Format(fmtTimeStr , [cHours, cMin, nSec]);
if timeVal < 0 then result := '- ' + Result;
end
else if Abs(timeval) > Round(60 * 1e09) then
begin
cMin := Abs(Timeval) div Round(60 * 1e09);
nSec := (Abs(Timeval) - cMin * Round(60 * 1e09)) div Round(1e09);
if timeVal >= 0 then
result := Format('%dmin %.5ds', [cMin, nSec])
else
result := Format('- %dmin %.5ds', [cMin, nSec]);
end
else
result := Format('%.5d', [timeval div Round(1e09)]) + 's';
end
else if Abs(timeval) > Round(1e06) then
result := Format('%.5d', [timeval div Round(1e06)]) + 'ms'
else if Abs(timeval) > 1e03 then
result := Format('%.5d', [timeval div Round(1e03)]) + Chr(181) + 's'
else
result := Format('%.5d', [timeval]) + 'ns';
except
On EInvalidOp do Result := 'Infinite time';
end;
end;
function TimeToFreqString(aTime: TTimeValue {in ns}): string; {Hz, kHz, MHz}
var freq: double;
begin
if aTime = 0 then
Result := '?Hz'
else
begin
freq := 1e09 / aTime;
if Abs(freq) < 1000 then
Result := Format('%.3g', [freq]) + 'Hz'
else if Abs(freq) < 1000000 then
Result := Format('%.3g', [freq/1000]) + 'kHz'
else
Result := Format('%.3g', [freq/1000000]) + 'MHz'
end;
end;
{*****************************************************************************}
{* List Box Functions *}
{*****************************************************************************}
procedure FillUnitListBox(listBox: TComboBox; sUnit: string);
begin
with listBox, listBox.Items do
begin
Clear;
Add('x' + sUnit);
Add('y' + sUnit);
Add('z' + sUnit);
Add('a' + sUnit);
Add('f' + sUnit);
Add('p' + sUnit);
Add('n' + sUnit);
Add(#181 + sUnit);
Add('m' + sUnit);
Add(sUnit);
Add('k' + sUnit);
Add('M' + sUnit);
Add('G' + sUnit);
Add('T' + sUnit);
Add('P' + sUnit);
Add('E' + sUnit);
Add('Z' + sUnit);
Add('Y' + sUnit);
Add('X' + sUnit);
end;
end;
function UnitPrefixToListBoxIndex(prefix: integer): integer;
begin
Result := (27 + prefix) div 3;
end;
function ListBoxIndexToUnitPrefix(listBoxIndex: integer): integer;
begin
Result := listBoxIndex * 3 - 27;
end;
procedure FillTimeListBox(listBox: TComboBox); {fill a list box with ns, us, etc...}
begin
with listBox, listBox.Items do
begin
Clear;
Add('ns');
Add(Chr(181) + 's');
Add('ms');
Add('s');
Add('min');
Add('hr');
end;
end;
procedure FillInputRangeListBox(listBox: TComboBox);
var i: TFullScaleVal;
begin
with listBox, listBox.Items do
begin
Clear;
for i := pm_42V to pm_0_2V do
Add(InputRangeToString(i));
end;
end;
procedure AbsoluteTimeToTimePrefix(absTime: TTimeValue; var dblTime: double; var timeIndex: integer);
var posTime: TTimeValue;
begin
posTime := Abs(absTime);
if absTime = 0 then
begin
timeIndex := 3; {seconds}
dblTime := 0;
end
else if posTime > Round(60 * 60 * 1e09) then
begin
timeIndex := 5;
dblTime := absTime div Round(60 * 60 * 1e09);
end
else if posTime > 60 * 1e09 then
begin
timeIndex := 4;
dblTime := absTime div Round(60 * 1e09);
end
else if posTime > 1e09 then
begin
timeIndex := 3;
dblTime := absTime div Round(1e09);
end
else if posTime > 1e06 then
begin
timeIndex := 2;
dblTime := absTime div Round(1e06);
end
else if posTime > 1e03 then
begin
timeIndex := 1;
dblTime := absTime div Round(1e03);
end
else
begin
timeIndex := 0;
dblTime := absTime;
end;
end;
function ListBoxIndexToTimePrefix(listBoxIndex: integer): TTimeValue;
begin
case listBoxIndex of
0: Result := 1;
1: Result := Round(1e03);
2: Result := Round(1e06);
3: Result := Round(1e09);
4: Result := Round(60 * 1e09);
5: Result := Round(3600 * 1e09);
else
Result := 1;
end;
end;
function FullScaleToVal(fs: TFullScaleVal): double;
begin
case fs of
pm_42V: Result := 42.0;
pm_20V: Result := 20.0;
pm_10V: Result := 10.0;
pm_5V: Result := 5.0;
pm_2V: Result := 2.0;
pm_1V: Result := 1.0;
pm_0_5V: Result := 0.5;
pm_0_2V: Result := 0.2;
else
Result := 0;
end;
end;
function InputRangeToString(inputRange: TFullScaleVal): string;
begin
case inputRange of
pm_42V: Result := Chr(177) + '42V';
pm_20V: Result := Chr(177) + '20V';
pm_10V: Result := Chr(177) + '10V';
pm_5V: Result := Chr(177) + '5V';
pm_2V: Result := Chr(177) + '2V';
pm_1V: Result := Chr(177) + '1V';
pm_0_5V: Result := Chr(177) + '0.5V';
pm_0_2V: Result := Chr(177) + '0.2V';
else
Result := '';
end;
end;
{****************************** Axis Label Functions *******************************}
{timeval is a time interval; returns a decade (in us...); used for time major tick
marks }
function TimeIntervalDecade(timeval: TTimeValue): TTimeValue;
var realTime: double;
begin
timeval := Abs(timeval);
if timeval = 0 then
Result := 0
else
if timeval > 60 * 60 * 1e09 then
begin
{The unit will be in hours}
realTime := timeval / (60 * 60 * 1e09);
realTime := Round( (Ln(realTime) / Ln(10)) + 1) * (60 * 60 * 1e09);
Result := Round(realTime);
end
else if timeval > 60 * 1e09 then
begin
{The unit will be in minutes}
realTime := timeval / (60 * 1e09);
realTime := Round( (Ln(realTime) / Ln(10)) + 1) * (60 * 1e09);
Result := Round(realTime);
end
else
begin
{The unit will be in seconds or decimal fractions of a second}
realTime := timeval;
Result := Round(Ln(realTime) / Ln(10)) + 1;
end;
end;
function IOErrToFileErr(code: integer): TFileErr;
begin
case code of
2: Result := feCannotFindFile;
3: Result := fePathNotFound;
4: Result := feTooManyFilesOpened;
5: Result := feAccessDenied;
6: Result := feInvalidHandle;
8: Result := feOutOfMemory;
100: Result := feUnexpectedEOF;
101: Result := feDiskFull;
102: Result := feFileNotAssigned;
103: Result := feFileNotOpen;
104: Result := feFileNotOpenForInput;
105: Result := feFileNotOpenForOutput;
106: Result := feInvalidInput;
else
Result := feUnknownError;
end;
end;
function FileErrToStr(fe: TFileErr): string;
begin
case fe of
feCannotFindFile: Result := sIOErr_FileNotFound;
fePathNotFound: Result := sIOErr_PathNotFound;
feTooManyFilesOpened: Result := sIOErr_TooManyOpenFiles;
feAccessDenied: Result := sIOErr_AccessDenied;
feBadFileType: Result := sIOErr_InvalidFileType;
feBadVersion: Result := sIOErr_InvalidVersion;
feForceConversion: Result := sIOErr_ForceConversion;
feDiskFull: Result := sIOErr_DiskFull;
feFileIsNotStorage: Result := sIOErr_FileIsNotStorage;
feOutOfMemory: Result := sIOErr_NotEnoughMemory;
feBadDiskDrive: Result := sIOErr_InvalidDrive;
feCannotReadFile: Result := sIOErr_CannotRead;
feUnknownError: Result := sIOErr_Unexpected;
feBadData: Result := sIOErr_BadData;
feUnexpectedEOF: Result := sIOErr_EOF;
feShareViolation: Result := sIOErr_SharingViolation;
feInvalidHandle: Result := sIOErr_InvalidHandle;
feFileNotAssigned: Result := sIOErr_FileNotAssigned;
feFileNotOpen: Result := sIOErr_FileNotOpen;
feFileNotOpenForInput: Result := sIOErr_FileNotOpenForInput;
feFileNotOpenForOutput: Result := sIOErr_FileNotOpenForOutput;
feInvalidInput: Result := sIOErr_InvalidInput;
feInvalidName: Result := sIOErr_InvalidName;
feNotAPXDFile: Result := sIOErr_NotAPXDFile;
else
Result := sIOErr_Unexpected;
end;
end;
// *****************************************************************************
//
// ROI Methods
//
// *****************************************************************************
procedure TSimpleROI.Draw(aCanvas: TCanvas; magnification: integer);
begin
with aCanvas do
begin
Pen.Mode := pmCopy;
Pen.Color := clWhite;
Pen.Width := 1;
Pen.Style := psDot;
end;
end;
procedure TRectangleROI.Draw(aCanvas: TCanvas; magnification: integer);
var magRect: TRect;
begin
inherited Draw(aCanvas, magnification);
magRect := rc;
NormalizeRect(magRect);
magRect.Left := magRect.Left * magnification;
magRect.Top := magRect.Top * magnification;
magRect.Right := (magRect.Right + 1) * magnification - 1;
magRect.Bottom := (magRect.Bottom + 1) * magnification - 1;
aCanvas.FrameRect(magRect);
end;
procedure TEllipseROI.Draw(aCanvas: TCanvas; magnification: integer);
var magRect: TRect;
begin
inherited Draw(aCanvas, magnification);
magRect := ellipse;
NormalizeRect(magRect);
magRect.Left := magRect.Left * magnification;
magRect.Top := magRect.Top * magnification;
magRect.Right := (magRect.Right + 1) * magnification - 1;
magRect.Bottom := (magRect.Bottom + 1) * magnification - 1;
aCanvas.Arc(magRect.Left, magRect.Top, magRect.Right, magRect.Bottom,
magRect.Left, magRect.Top + (magRect.Bottom - magRect.Top + 1) div 2,
magRect.Left, magRect.Top + (magRect.Bottom - magRect.Top + 1) div 2);
end;
procedure TPolygonROI.Draw(aCanvas: TCanvas; magnification: integer);
var newPolygon: array of TPoint; {has one more element to close the array}
i: integer;
begin
inherited Draw(aCanvas, magnification);
SetLength(newPolygon, Length(Polygon) + 1);
for i := 0 to Length(Polygon) - 1 do
begin {to center polygon}
newPolygon[i].X := polygon[i].X * magnification + magnification div 2;
newPolygon[i].Y := polygon[i].Y * magnification + magnification div 2;
end;
newPolygon[Length(Polygon)] := newPolygon[0]; {closes the polygon}
aCanvas.Polyline(newPolygon);
end;
function TROI.GetSimpleROIs(index: integer): TSimpleROI;
begin
if (index >= 0) and (index < count) then
Result := TSimpleROI(Items[index])
else
Result := nil;
end;
type
{a better substitute for PRgnData (in Windows.pas)}
TRGNDataBuffer = record
rdh: TRgnDataHeader;
rects: array[0..0] of TRect;
end;
TpRGNDataBuffer = ^TRGNDataBuffer;
function TROI.GetPixelCount: integer;
var pRegionBuffer: TpRGNDataBuffer;
k: integer;
begin
Result := 0;
pRegionBuffer := AllocMem(1024);
try
if GetRegionData(handleRGN, 1024, PRgnData(pRegionbuffer)) <> 0 then
with pRegionbuffer^ do
if rdh.nCount > 0 then
begin
for k := 0 to rdh.nCount - 1 do
Result := Result + (rects[k].Right - rects[k].Left + 1) *
(rects[k].Bottom - rects[k].Top + 1);
{cache the rectangles for enumeration}
rectCount := rdh.nCount;
SetLength(regionRects, rectCount);
for k := 0 to rectCount - 1 do
regionRects[k] := rects[k];
rectIndex := 0;
i := regionRects[0].Left - 1;
j := regionRects[0].Top;
end;
finally
FreeMem(pRegionBuffer, 1024);
end;
end;
function TROI.NextPtInROI(var pt: TPoint): boolean;
begin
Result := False;
i := i + 1;
if i > regionRects[rectIndex].Right then
begin
if j < regionRects[rectIndex].Bottom then
begin
j := j + 1;
i := regionRects[rectIndex].Left;
Result := True;
end
else
begin
rectIndex := rectIndex + 1;
if rectIndex < rectCount - 1 then
begin
rectIndex := rectIndex + 1;
i := regionRects[rectIndex].Left;
j := regionRects[rectIndex].Top;
Result := True;
end
else
begin {result := False}
rectIndex := 0;
i := regionRects[0].Left - 1;
j := regionRects[0].Top;
end;
end;
end
else
Result := True;
if Result = True then
begin
pt.X := i;
pt.Y := j;
end;
end;
function TROI.AddSimpleROI(Item: TSimpleROI): integer;
var itemHandle: HRgn;
begin
Result := -1;
if Item is TRectangleROI then
with Item as TRectangleROI do
itemHandle := CreateRectRgn(rc.Left, rc.Right + 1, rc.Top, rc.Bottom + 1)
else if Item is TEllipseROI then
with Item as TEllipseROI do
itemHandle := CreateEllipticRgn(ellipse.Left, ellipse.Right, ellipse.Top, ellipse.Bottom)
else
with Item as TPolygonROI do {very dubious argument: polygon[0]}
itemHandle := CreatePolygonRgn(polygon[0], Length(polygon), ALTERNATE);
if Count = 0 then
begin
handleRgn := itemHandle;
Result := Add(Item);
end
else
if CombineRgn(handleRgn, handleRgn, itemHandle, RGN_OR) <> 0 {<> ERROR} then
begin
Result := Add(Item);
DeleteObject(itemHandle);
end;
end;
procedure TROI.Draw(aCanvas: TCanvas; magnification: integer);
var k: integer;
begin
if Count > 0 then
for k := 0 to Count - 1 do
TSimpleROI(Items[k]).Draw(aCanvas, magnification);
end;
destructor TROI.Destroy;
var k: integer;
begin
if Count > 0 then
for k := 0 to Count - 1 do
TSimpleROI(Items[k]).Free;
{destroys handleRgn}
if handleRgn <> 0 then DeleteObject(handleRgn);
inherited Destroy;
end;
function FindCommonRegion(start1, end1, start2, end2: integer;
var commonStart, commonEnd: integer): boolean;
begin
{make sure that end1 <= start1}
if start1 > end1 then
begin
commonStart := start1;
start1 := end1;
end1 := commonStart;
end;
if start2 > end2 then
begin
commonStart := start2;
start2 := end2;
end2 := commonStart;
end;
if start1 > start2 then
begin
commonStart := start1;
commonEnd := end1;
// start1 := start2; no need
end1 := end2;
start2 := commonStart;
end2 := commonEnd;
end;
if start2 > end1 then
Result := False
else
begin
commonStart := start2;
if end2 <= end1 then
commonEnd := end2
else
commonEnd := end1;
Result := True;
end;
end;
procedure NormalizeRect(var rect: TRect);
var i: integer;
begin
if rect.Left > rect.Right then
begin
i := rect.Left;
rect.Left := rect.Right;
rect.Right := i;
end;
if rect.Top > rect.Bottom then
begin
i := rect.Top;
rect.Top := rect.Bottom;
rect.Bottom := i;
end;
end;
{******************************** CONFIGURATION ********************************}
function TConfiguration.GetChAnalogFreqs(chIndex: integer): double;
begin
Result := GetFrameRate * fChDataPtsPerFrames[chIndex];
end;
function TConfiguration.GetChConvFactors(chIndex: integer): double;
begin
Result := fChConvFactors[chIndex];
end;
function TConfiguration.GetChCount: integer;
begin
Result := AnalogChCount + VideoChCount;
end;
function TConfiguration.GetChDataPtsPerFrames(chIndex: integer): integer;
begin
Result := fChDataPtsPerFrames[chIndex];
end;
function TConfiguration.GetChEnabled(chIndex: integer): boolean;
begin
Result := fChEnabled[chIndex];
end;
function TConfiguration.GetChInputRanges(chIndex: integer): TFullScaleVal;
begin
Result := fChInputRanges[chIndex];
end;
function TConfiguration.GetChNames(chIndex: integer): string;
begin
Result := fChNames[chIndex];
end;
function TConfiguration.GetChOffsets(chIndex: integer): double;
begin
Result := fChOffsets[chIndex];
end;
function TConfiguration.GetChPrefixes(chIndex: integer): TPrefix;
begin
Result := fChPrefixes[chIndex];
end;
function TConfiguration.GetChUnits(chIndex: integer): string;
begin
Result := fChUnits[chIndex];
end;
{The number of points collected = linear portion (frameWidth) + retrace sine points
which are discarded}
function TConfiguration.GetFullFrameWidth: integer;
begin
Result := Muldiv(FrameWidth, 5, 4);
end;
procedure TConfiguration.DefaultConfig;
var i: integer;
begin
sConfigName := '';
fXFrameOffset := 0;
fYFrameOffset := 0;
fFrameWidth := 500;
fFrameHeight := 500;
fPixelClock := 16; {1.25 MHz}
for i := 0 to MAX_CH - 1 do
begin
fChConvFactors[i] := 1;
fChDataPtsPerFrames[i] := 1000;
fChInputRanges[i]:= pm_10V;
fChNames[i]:= 'Channel ' + IntToStr(i+1);
fChOffsets[i] := 0;
fChPrefixes[i] := tpUNITY;
fChUnits[i] := 'V';
end;
fChEnabled[0] := True;
fChEnabled[1] := False;
fChEnabled[2] := False;
fChEnabled[3] := False;
end;
function TConfiguration.GetAnalogChCount: integer;
begin
Result := 0;
if fChEnabled[2] then Result := 1;
if fChEnabled[3] then Result := Result + 1;
end;
function TConfiguration.GetFrameRate: double;
begin
Result := 1 / (fullFrameWidth * fFrameHeight * fPixelClock * BASE_CLOCK);
end;
procedure TConfiguration.GetMaxFrameRate(iframeWidth, iFrameHeight: integer; var newFrameRate: double;
var newPixelRate: integer);
var freq: double;
begin
if iframeWidth < 100 then
freq := 1700 {1.7 kHz limit}
else
{125 pixels: 1.7 kHz ; 625 pixels: 1.25 kHz}
freq := 1700 - 4 * (Muldiv(iFrameWidth, 5, 4) - 125) / 5;
newPixelRate := Floor(((1 / (freq * 2)) / Muldiv(iFrameWidth, 5, 4)) / 5e-8);
newFrameRate := 1 / (Muldiv(iFrameWidth, 5, 4) * iFrameHeight * newPixelRate * BASE_CLOCK);
end;
function TConfiguration.GetVideoChCount: integer;
begin
Result := 0;
if fChEnabled[0] then Result := 1;
if fChEnabled[1] then Result := Result + 1;
end;
procedure TConfiguration.SetChConvFactors(chIndex: integer; newconvfactor: double);
begin
fChConvFactors[chIndex] := newconvfactor;
end;
procedure TConfiguration.SetChDataPtsPerFrames(chIndex: integer; newDataPtsPerFrames: integer);
begin
if newDataPtsPerFrames < 0 then Exit;
if newDataPtsPerFrames <= fFrameWidth * fFrameHeight then
begin
bDirty := True;
fChDataPtsPerFrames[chIndex] := newDataPtsPerFrames;
end;
end;
procedure TConfiguration.SetChEnabled(chIndex: integer; newChEnabled: boolean);
begin
fChEnabled[chIndex] := newChEnabled;
bDirty := True;
end;
procedure TConfiguration.SetChInputRanges(chIndex: integer; newChInputRanges: TFullScaleVal);
begin
fChInputRanges[chIndex] := newChInputRanges;
bDirty := True;
end;
procedure TConfiguration.SetChNames(chIndex: integer; newChNames: string);
begin
fChNames[chIndex] := newChNames;
bDirty := True;
end;
procedure TConfiguration.SetChOffsets(chIndex: integer; newChOffsets: double);
begin
fChOffsets[chIndex] := newChOffsets;
bDirty := True;
end;
procedure TConfiguration.SetChPrefixes(chIndex: integer; newChPrefixes: TPrefix);
begin
fChPrefixes[chIndex] := newChPrefixes;
bDirty := True;
end;
procedure TConfiguration.SetChUnits(chIndex: integer; newChUnits: string);
begin
fChUnits[chIndex] := newChUnits;
bDirty := True;
end;
procedure TConfiguration.SetFrameHeight(newHeight: integer);
begin
if (newHeight <= 500) and (newHeight >= 10) then
begin
newHeight := (newHeight div 2) * 2;
fFrameHeight := newHeight;
bDirty := True;
end
else
Raise EMPConfig.Create('Frame height must be between 10 and 500 lines');
end;
procedure TConfiguration.SetFrameRate(newRate: double);
var newPixelClock: integer;
lineFreq, maxFreq: double;
begin
if newRate <= 0 then Raise EMPConfig.Create('Invalid frame rate');
lineFreq := (newRate * fFrameHeight) / 2;
if fFrameWidth < 100 then maxFreq := 1700 else maxFreq := 1700 - 4 * (fullFrameWidth - 125) / 5;
if lineFreq <= maxFreq then
begin
newPixelClock := Floor(((1 / (lineFreq * 2)) / fullFrameWidth) / 5e-8);
{the pixel clock must be <= 2.5 MHz and >= 20 kHz with a 20 MHz timebase}
if (newpixelClock >= 8) and (newpixelClock <= 1000) then
begin
fPixelClock := newPixelClock;
bDirty := True;
end;
end;
end;
function TConfiguration.PixelRateToFrameRate(newPixelRate, iframeWidth, iframeHeight: integer; var newFrameRate: double): boolean;
var lineFreq, maxFreq: double;
begin
newFrameRate := 1 / (Muldiv(iframeWidth, 5, 4) * newPixelRate * iframeHeight * 5e-8);
lineFreq := (newFrameRate * iframeHeight) / 2;
if iFrameWidth < 100 then maxFreq := 1700 else maxFreq := 1700 - 4 * (Muldiv(iframeWidth, 5, 4) - 125) / 5;
if lineFreq <= maxFreq then
Result := True
else
Result := False;
end;
function TConfiguration.FrameRateToPixelRate(newFrameRate: double; iframeWidth, iframeHeight: integer; var newPixelRate: integer): boolean;
var lineFreq: double;
maxFreq: double;
begin
Result := True;
if newFrameRate <= 0 then
Result := False
else
begin
lineFreq := (newFrameRate * iframeHeight) / 2;
if iFrameWidth < 100 then maxFreq := 1700 else maxFreq := 1700 - 4 * (Muldiv(iframeWidth, 5, 4) - 125) / 5;
if lineFreq <= maxFreq then
begin
newPixelRate := Floor( ( (1 / (lineFreq * 2) ) / (Muldiv(iframeWidth, 5, 4)) / 5e-8));
{the pixel clock must be <= 2.5 MHz and >= 20 kHz with a 20 MHz timebase}
if newPixelRate < 8 then Result := False;
end
else
Result := False;
end;
if Result = False then
GetMaxFrameRate(iframeWidth, iFrameHeight, newFrameRate, newPixelRate);
end;
procedure TConfiguration.SetFrameWidth(newWidth: integer);
begin
if (newWidth <= 500) and (newWidth >= 10) then
begin
fFrameWidth := newWidth;
bDirty := True;
end
else
Raise EMPConfig.Create('Frame width must be between 10 and 500 pixels');
end;
procedure TConfiguration.SetPixelClock(newClockRate: integer);
begin
if (newClockRate >= 8) and (newClockRate <= 1000) then
begin
fPixelClock := newClockRate;
bDirty := True;
end;
end;
procedure TConfiguration.SetScanMode(newMode: TScanMode);
begin
fScanMode := newMode;
bDirty := True;
end;
procedure TConfiguration.SetXFrameOffset(newXOffset: integer);
begin
if (newXOffset <= 490) and (newXOffset >= 0) then
begin
fXFrameOffset := newXOffset;
bDirty := True;
end;
end;
procedure TConfiguration.SetYFrameOffset(newYOffset: integer);
begin
if (newYOffset <= 490) and (newYOffset >= 0) then
begin
fYFrameOffset := newYOffset;
bDirty := True;
end;
end;
function TConfiguration.AnalogToDigitalValue(chIndex: integer; analogVal: double): integer;
begin
Result := Round(2048 * (analogVal - PrefixToFactor(fChPrefixes[chIndex]) * fChOffsets[chIndex])/(fChConvFactors[chIndex]
* FullScaleToVal(fChInputRanges[chIndex])));
end;
procedure TConfiguration.CopyTo(var configRecord: TConfigRecord);
var i: integer;
begin
configRecord.XFrameOffset := fXFrameOffset;
configRecord.YFrameOffset := fYFrameOffset;
configRecord.FrameWidth := fFrameWidth;
configRecord.FrameHeight := fFrameHeight;
configRecord.PixelClock := fPixelClock;
for i := 0 to 3 do
begin
configRecord.ChConvFactors[i] := fChConvFactors[i];
configRecord.ChDataPtsPerFrames[i] := fChDataPtsPerFrames[i];
configRecord.ChEnabled[i] := fChEnabled[i];
configRecord.ChInputRanges[i] := fChInputRanges[i];
configRecord.ChNames[i] := fChNames[i];
configRecord.ChOffsets[i] := fChOffsets[i];
configRecord.ChPrefixes[i] := fChPrefixes[i];
configRecord.ChUnits[i] := fChUnits[i];
end;
end;
function TConfiguration.DigitalToAnalogValue(chIndex: integer; digitalVal: integer): double;
begin
Result := fChConvFactors[chIndex] *
FullScaleToVal(fChInputRanges[chIndex]) * (digitalVal / 2048) +
PrefixToFactor(fChPrefixes[chIndex]) * fChOffsets[chIndex];
end;
const
sFrame = 'Frame';
sOptions = 'Options';
sXFrameOffset = 'X Frame Offset';
sYFrameOffset = 'Y Frame Offset';
sFrameWidth = 'Frame Width';
sFrameHeight = 'Frame Height';
sPixelClock = 'Pixel Clock';
sChannel = 'Channel ';
sChConvFactors = 'Conv Factor';
sChDataPtsPerFrames = 'Data Pts Per Frame';
sChEnabled = 'Enabled';
sChInputRanges = 'Input Range';
sChNames = 'Name';
sChOffsets = 'Offset';
sChPrefixes = 'Prefix';
sChUnits = 'Unit';
procedure TConfiguration.OpenConfiguration(const fname: string);
var configIni: TIniFile;
i: integer;
begin
configIni := TIniFile.Create(fname);
try
with configIni do
begin
fXFrameOffset := ReadInteger(sFrame, sXFrameOffset, 0);
fYFrameOffset := ReadInteger(sFrame, sYFrameOffset, 0);
fFrameWidth := ReadInteger(sFrame, sFrameWidth, 500);
fFrameHeight := ReadInteger(sFrame, sFrameHeight, 500);
fPixelClock := ReadInteger(sFrame, sPixelClock, 16); {1.25 MHz}
for i := 1 to 4 do
begin
fChConvFactors[i-1] := ReadFloat(sChannel + IntToStr(i), sChConvFactors, 1);
fChDataPtsPerFrames[i-1] := ReadInteger(sChannel + IntToStr(i), sChDataPtsPerFrames, 100);
fChEnabled[i-1] := ReadBool(sChannel + IntToStr(i), sChEnabled, True);
fChInputRanges[i-1] := TFullScaleVal(ReadInteger(sChannel + IntToStr(i), sChInputRanges, 0));
fChNames[i-1] := ReadString(sChannel + IntToStr(i), sChNames, sChannel + IntToStr(i));
fChOffsets[i-1] := ReadFloat(sChannel + IntToStr(i), sChOffsets, 0);
fChPrefixes[i-1] := TPrefix(ReadInteger(sChannel + IntToStr(i), sChPrefixes, 0));
fChUnits[i-1] := ReadString(sChannel + IntToStr(i), sChUnits, 'V');
end;
end;
bDirty := False;
sConfigName := fname;
finally
configIni.Free;
end;
end;
procedure TConfiguration.RestoreFrom(const configRecord: TConfigRecord);
var i: integer;
begin
fXFrameOffset := configRecord.XFrameOffset;
fYFrameOffset := configRecord.YFrameOffset;
fFrameWidth := configRecord.FrameWidth;
fFrameHeight := configRecord.FrameHeight;
fPixelClock := configRecord.PixelClock;
for i := 0 to 3 do
begin
fChConvFactors[i] := configRecord.ChConvFactors[i];
fChDataPtsPerFrames[i] := configRecord.ChDataPtsPerFrames[i];
fChEnabled[i] := configRecord.ChEnabled[i];
fChInputRanges[i] := configRecord.ChInputRanges[i];
fChNames[i] := configRecord.ChNames[i];
fChOffsets[i] := configRecord.ChOffsets[i];
fChPrefixes[i] := configRecord.ChPrefixes[i];
fChUnits[i] := configRecord.ChUnits[i];
end;
end;
procedure TConfiguration.SaveConfiguration(const fname: string);
var configIni: TIniFile;
i: integer;
begin
if fname = '' then Exit;
configIni := TIniFile.Create(fname);
try
with configIni do
begin
WriteInteger(sFrame, sXFrameOffset, fXFrameOffset);
WriteInteger(sFrame, sYFrameOffset, fYFrameOffset);
WriteInteger(sFrame, sFrameWidth, fFrameWidth);
WriteInteger(sFrame, sFrameHeight, fFrameHeight);
WriteInteger(sFrame, sPixelClock, fPixelClock);
for i := 1 to 4 do
begin
WriteFloat(sChannel + IntToStr(i), sChConvFactors, ChConvFactors[i-1]);
WriteInteger(sChannel + IntToStr(i), sChDataPtsPerFrames, fChDataPtsPerFrames[i-1]);
WriteBool(sChannel + IntToStr(i), sChEnabled, fChEnabled[i-1]);
WriteInteger(sChannel + IntToStr(i), sChInputRanges, Integer(fChInputRanges[i-1]));
WriteString(sChannel + IntToStr(i), sChNames, fChNames[i-1]);
WriteFloat(sChannel + IntToStr(i), sChOffsets, fChOffsets[i-1]);
WriteInteger(sChannel + IntToStr(i), sChPrefixes, Integer(fChPrefixes[i-1]));
WriteString(sChannel + IntToStr(i), sChUnits, fChUnits[i-1]);
end;
end;
bDirty := False;
sConfigName := fname;
finally
configIni.Free;
end;
end;
constructor TConfiguration.Create;
begin
DefaultConfig;
end;
{*********************************** MPFile ***********************************}
function TMPFile.DefaultFileName(const fileDir: string): string;
var i: integer;
begin
i := 0;
repeat
i := i + 1;
Result := FormatDateTime('yymmdd', Now) + '_' + Format('%.3d', [i]) + '.MPD';
until not FileExists(ExcludeTrailingBackslash(fileDir) + '\' + Result);
end;
procedure TMPFile.Close(sComments: string);
var ps: TpPropSpecArray;
pv: TpPropVariantArray;
const sPropName: WideString = 'Comments';
begin
if bDirty then
begin
if Length(sComments) > 0 then
begin
ps := nil; pv := nil;
try
GetMem(ps, SizeOf(TPropSpec));
GetMem(pv, SizeOf(TPropVariant));
ps^[0].ulKind := PRSPEC_LPWSTR;
ps^[0].lpwstr := PWideChar(sPropName);
{ pv^[0].vt := VT_LPSTR;
pv^[0].pszVal := PChar(@sComments[1]);}
pv^[0].vt := VT_LPWSTR;
pv^[0].pwszVal := StringToOLEStr(sComments);
{ pv^[0].vt := VT_LPSTR;
pv^[0].pszVal := @(PChar(sComments)^);}
OleCheck(fPropertyStorage.WriteMultiple(1, @ps[0], @pv[0], 2));
finally
if ps <> nil then Freemem(ps);
if pv <> nil then Freemem(pv);
end;
end;
OleCheck(fPropertyStorage.Commit(STGC_DEFAULT));
end;
fPropertyStorage := nil;
fPropertySetStorage := nil;
if streams[0] <> nil then streams[0] := nil;
if streams[1] <> nil then streams[0] := nil;
if streams[2] <> nil then streams[0] := nil;
if streams[3] <> nil then streams[0] := nil;
rootStorage := nil;
if not bDirty then DeleteFile(filename);
end;
const
OFLAGS = STGM_DIRECT or STGM_READWRITE or STGM_CREATE or STGM_SHARE_EXCLUSIVE;
procedure TMPFile.NewFile(const sNewFile: string);
var hr : HResult;
ws: Widestring;
begin
ws := sNewFile;
hr := StgCreateDocFile(PWideChar(ws), OFLAGS, 0, rootStorage);
if not Succeeded(hr) then
begin
MessageDlg(FileErrToStr(StgErrToFileErr(hr)), mtError, [mbOK], 0);
{possible cause: bad file name; try default file name}
ws := ExcludeTrailingBackslash(ExtractFilePath(Filename)) + '\' +
DefaultFileName(ExcludeTrailingBackslash(ExtractFilePath(Filename)));
hr := StgCreateDocFile(PWideChar(ws), OFLAGS, 0, rootStorage);
end;
if Succeeded(hr) then
begin
sFilename := sNewFile;
fPropertySetStorage := rootStorage as IPropertySetStorage;
if not Succeeded(fPropertySetStorage.Create(FMTID_User_Defined_Properties,
FMTID_User_Defined_Properties, PROPSETFLAG_DEFAULT, OFLAGS, fPropertyStorage)) then
MessageDlg('Cannot open property set', mtError, [mbOK], 0);
rootStorage.SetClass(GUID_MPD);
end;
end;
function BooleanToString(abool: Boolean): string;
begin
if abool then Result := 'True' else Result := 'False';
end;
function ScanModeToString(smode: TScanMode): string;
begin
case smode of
SM_MOVIE: Result := 'Movie';
SM_STACK: Result := 'Image Stack';
SM_STACKMOVIE: Result := 'Image Stack Movie';
SM_LINESCAN: Result := 'Line Scan';
SM_REPEAT_LINESCAN: Result := 'Repeat Line Scan';
else Result := '';
end
end;
procedure TMPFile.SetProperties(const config: TConfiguration);
const sPropNames: array[0..29] of string = ('Scan Mode', 'Stack Count', 'z- Interval', 'X Frame Offset', 'Y Frame Offset',
'Frame Width', 'Frame Height', 'Pixel Clock',
'Channel name (1)', 'Enabled (1)', 'Input Range (1)',
'Channel name (2)', 'Enabled (2)', 'Input Range (2)',
'Channel name (3)', 'Enabled (3)', 'Input Range (3)', 'Channel Unit (3)',
'Channel Prefix (3)', 'Conversion factor (3)', 'Offset (3)', 'Data Points Per Frame (3)',
'Channel name (4)', 'Enabled (4)', 'Input Range (4)', 'Channel Unit (4)',
'Channel Prefix (4)', 'Conversion factor (4)', 'Offset (4)', 'Data Points Per Frame (4)');
var i, j : integer;
sPropValues: array[0..29] of string;
ps: TpPropSpecArray;
pv: TpPropVariantArray;
wc: Widestring;
begin
with config do
begin
sPropValues[0] := ScanModeToString(ScanMode);
sPropValues[1] := IntToStr(stackCount);
sPropValues[2] := FloatToStr(zInterval);
sPropValues[3] := IntToStr(XFrameOffset);
sPropValues[4] := IntToStr(YFrameOffset);
sPropValues[5] := IntToStr(FrameWidth);
sPropValues[6] := IntToStr(FrameHeight);
sPropValues[7] := IntToStr(PixelClock);
j := 8;
for i := 0 to 3 do
begin
sPropValues[j] := ChNames[i]; j := j + 1;
sPropValues[j] := BooleanToString(ChEnabled[i]); j := j + 1;
sPropValues[j] := InputRangeToString(ChInputRanges[i]); j := j + 1;
if i > 1 then
begin
sPropValues[j] := ChUnits[i]; j := j + 1;
sPropValues[j] := PrefixToString(ChPrefixes[i]); j := j + 1;
sPropValues[j] := FloatToStr(ChConvFactors[i]); j := j + 1;
sPropValues[j] := FloatToStr(ChOffsets[i]); j := j + 1;
sPropValues[j] := IntToStr(ChDataPtsPerFrames[i]); j := j + 1;
end;
end;
end;
ps := nil; pv := nil;
try
GetMem(ps, 30 * SizeOf(TPropSpec));
GetMem(pv, 30 * SizeOf(TPropVariant));
for i := 0 to 29 do
begin
ps^[i].ulKind := PRSPEC_LPWSTR;
ps^[i].lpwstr := StringToOLEStr(sPropNames[i]);
{ps^[i].lpwstr := @(StringToWideChar(sPropNames[i], @sWideChar, Length(sPropNames[i]) + 1)^);}
{pv^[i].vt := VT_LPSTR;
pv^[i].pszVal := PChar(@sPropValues[i][1]);}
pv^[i].vt := VT_LPWSTR;
pv^[i].pwszVal := StringToOLEStr(sPropValues[i]);
{ pv^[i].vt := VT_LPSTR;
pv^[i].pszVal := @(PChar(sPropValues[i])^);}
end;
OleCheck(fPropertyStorage.WriteMultiple(30, @ps[0], @pv[0], 2));
finally
if ps <> nil then Freemem(ps);
if pv <> nil then Freemem(pv);
end;
{creates the data streams}
for i := 0 to 3 do
if config.ChEnabled[i] then
begin
wc := 'Ch'+IntToStr(i);
OLECheck(rootStorage.CreateStream(@wc, OFLAGS, 0, 0, streams[i]));
end;
end;
function TMPFile.Write(streamIndex: integer; var data; cbytes: integer): boolean;
var cbWritten: longint;
begin
try
if (streamIndex >= 0) and (streamIndex <= 3) then
if streams[streamIndex] <> nil then
OleCheck(streams[streamIndex].Write(@data, cbytes, @cbWritten));
Result := True;
except
Result := False;
end;
end;
constructor TMPFile.Create(const sInitialDir: string);
begin
sFileName := ExcludeTrailingBackslash(sInitialDir) + '\' + DefaultFileName(sInitialDir);
NewFile(sFileName);
end;
function StgErrToFileErr(hr: HResult): TFileErr;
begin
{if integer(hr) = STG_E_INVALIDFUNCTION then
else} if integer(hr) = STG_E_FILENOTFOUND then
Result := feCannotFindFile
else if integer(hr) = STG_E_PATHNOTFOUND then
Result := fePathNotFound
else if integer(hr) = STG_E_TOOMANYOPENFILES then
Result := feTooManyFilesOpened
else if integer(hr) = STG_E_ACCESSDENIED then
Result := feAccessDenied
{ else if integer(hr) = STG_E_INVALIDHANDLE then
Result := ;}
else if integer(hr) = STG_E_INSUFFICIENTMEMORY then
Result := feOutOfMemory
else if integer(hr) = STG_E_INVALIDPOINTER then
Result := feBadData
{ else if integer(hr) = STG_E_NOMOREFILES then
Result := ;}
else if integer(hr) = STG_E_DISKISWRITEPROTECTED then
Result := feCannotReadFile
else if integer(hr) = STG_E_SEEKERROR then
Result := feCannotReadFile
else if integer(hr) = STG_E_WRITEFAULT then
Result := feUnexpectedEOF
else if integer(hr) = STG_E_READFAULT then
Result := feCannotReadFile
else if integer(hr) = STG_E_SHAREVIOLATION then
Result := feShareViolation
{ else if integer(hr) = STG_E_LOCKVIOLATION then
Result := ;
else if integer(hr) = STG_E_FILEALREADYEXISTS then
Result := ;
else if integer(hr) = STG_E_INVALIDPARAMETER then
Result := ;}
else if integer(hr) = STG_E_MEDIUMFULL then
Result := feDiskFull
{ else if integer(hr) = STG_E_ABNORMALAPIEXIT then
Result := ;
else if integer(hr) = STG_E_INVALIDHEADER then
Result := ;}
else if integer(hr) = STG_E_INVALIDNAME then
Result := feInvalidName
else if integer(hr) = STG_E_UNKNOWN then
Result := feUnknownError
{ else if integer(hr) = STG_E_UNIMPLEMENTEDFUNCTION then
Result := ;
else if integer(hr) = STG_E_INVALIDFLAG then
Result := ;}
else
Result := feUnknownError;
end;
function PointStrictlyInRect(const aPt: TPoint; aRect: TRect): boolean;
begin
NormalizeRect(aRect);
if (aPt.X >= aRect.Left) and (aPt.X <= aRect.Right) and
(aPt.Y >= aRect.Top) and (aPt.Y <= aRect.Bottom) then
Result := True
else
Result := False;
end;
end.
Raw
MPScan TLB
// ************************************************************************ //
{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers.
{$WARN SYMBOL_PLATFORM OFF}
{$WRITEABLECONST ON}
{$VARPROPSETTER ON}
interface
uses Windows, ActiveX, Classes, Graphics, StdVCL, Variants;
// *********************************************************************//
// GUIDS declared in the TypeLibrary. Following prefixes are used:
// Type Libraries : LIBID_xxxx
// CoClasses : CLASS_xxxx
// DISPInterfaces : DIID_xxxx
// Non-DISP interfaces: IID_xxxx
// *********************************************************************//
const
// TypeLibrary Major and minor versions
MPSCAN_PCMajorVersion = 1;
MPSCAN_PCMinorVersion = 0;
LIBID_MPSCAN_PC: TGUID = '{1961FB4B-89F1-4E35-8884-1B28F8244C7A}';
IID_IMultiphoton: TGUID = '{528196B3-544E-4C91-A526-2FE2AA21333D}';
IID_IMPLaserShutter: TGUID = '{637AD17F-5D45-40AE-9759-2CCD019F6CD2}';
DIID_IMultiphotonEvents: TGUID = '{7E98D2E3-6D6C-4272-A726-D0E083CC2367}';
CLASS_MultiPhoton: TGUID = '{77B5B174-06ED-48B8-AF6E-E1832F70217F}';
CLASS_MPLaserShutter: TGUID = '{2B3B5753-7DB9-4F42-A922-9FA646C71138}';
IID_IMPXYTable: TGUID = '{C66DFBD1-03E6-4E52-84E9-CA6F0C64E6F9}';
CLASS_MPXYTable: TGUID = '{1527F79A-6579-4DA7-AEB1-E0EA516463FD}';
IID_IMPZStepper: TGUID = '{C6A2E09D-B249-4564-9DC8-5FBE10FCB8EF}';
CLASS_MPZStepper: TGUID = '{32C1BEE8-52F1-45DC-82E8-3955F5CFF9C0}';
IID_IMatlab: TGUID = '{AA58FC68-0FA8-4327-8B53-888ABAD56938}';
CLASS_MPMatlab: TGUID = '{04CEF2DA-92AF-4FFF-B178-9B776A60357C}';
IID_IMPCounter: TGUID = '{A69A0D54-D5DD-4EF3-A1CC-6950148116B6}';
CLASS_MPCounter: TGUID = '{E76CE279-58CC-42B4-9DD9-742B02A3D5C4}';
IID_IMPLaserControl: TGUID = '{A4CE28BD-F4AB-4395-8A32-A8C86FD9B56F}';
CLASS_MPLaserControl: TGUID = '{0FEC246A-0D56-417D-A21A-E26A4651E117}';
type
// *********************************************************************//
// Forward declaration of types defined in TypeLibrary
// *********************************************************************//
IMultiphoton = interface;
IMultiphotonDisp = dispinterface;
IMPLaserShutter = interface;
IMPLaserShutterDisp = dispinterface;
IMultiphotonEvents = dispinterface;
IMPXYTable = interface;
IMPXYTableDisp = dispinterface;
IMPZStepper = interface;
IMPZStepperDisp = dispinterface;
IMatlab = interface;
IMatlabDisp = dispinterface;
IMPCounter = interface;
IMPCounterDisp = dispinterface;
IMPLaserControl = interface;
IMPLaserControlDisp = dispinterface;
// *********************************************************************//
// Declaration of CoClasses defined in Type Library
// (NOTE: Here we map each CoClass to its Default Interface)
// *********************************************************************//
MultiPhoton = IMultiphoton;
MPLaserShutter = IMPLaserShutter;
MPXYTable = IMPXYTable;
MPZStepper = IMPZStepper;
MPMatlab = IMatlab;
MPCounter = IMPCounter;
MPLaserControl = IMPLaserControl;
// *********************************************************************//
// Declaration of structures, unions and aliases.
// *********************************************************************//
PWideString1 = ^WideString;
// *********************************************************************//
// Interface: IMultiphoton
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {528196B3-544E-4C91-A526-2FE2AA21333D}
// *********************************************************************//
IMultiphoton = interface(IDispatch)
['{528196B3-544E-4C91-A526-2FE2AA21333D}']
procedure AddFileProperty(const propname: WideString; const propvalue: WideString); safecall;
procedure Set_FileComments(const Param1: WideString); safecall;
function Get_Laser_Shutter: MPLaserShutter; safecall;
procedure LoadConfiguration(const configName: WideString); safecall;
procedure SetLaserBeamTo(X: Integer; Y: Integer); safecall;
procedure StartDigitalStim; safecall;
procedure StopDigitalStimulation; safecall;
procedure StartScan; safecall;
procedure StopScan; safecall;
procedure StartStreaming; safecall;
procedure StopStreaming; safecall;
procedure SetDigitalBit(digitalline: Integer; digitalvalue: Integer); safecall;
procedure NewDataFile(const filename: WideString); safecall;
procedure Wait(mscount: Integer); safecall;
function Get_LastFrameIndex: Integer; safecall;
function Get_matlab: MPMatlab; safecall;
function Get_XY_Table: MPXYTable; safecall;
function Get_Z_Stepper: MPZStepper; safecall;
function Get_Scanning: Integer; safecall;
procedure DoEvents; safecall;
function Get_YScanOffset: Integer; safecall;
procedure Set_YScanOffset(Value: Integer); safecall;
procedure EndScript; safecall;
function Get_GPCTR0: MPCounter; safecall;
function Get_GPCTR1: MPCounter; safecall;
function Get_Laser: MPLaserControl; safecall;
procedure LoadDigitalStim(const digitalstimFile: WideString); safecall;
procedure WriteMessage(const Param1: WideString); safecall;
property FileComments: WideString write Set_FileComments;
property Laser_Shutter: MPLaserShutter read Get_Laser_Shutter;
property LastFrameIndex: Integer read Get_LastFrameIndex;
property matlab: MPMatlab read Get_matlab;
property XY_Table: MPXYTable read Get_XY_Table;
property Z_Stepper: MPZStepper read Get_Z_Stepper;
property Scanning: Integer read Get_Scanning;
property YScanOffset: Integer read Get_YScanOffset write Set_YScanOffset;
property GPCTR0: MPCounter read Get_GPCTR0;
property GPCTR1: MPCounter read Get_GPCTR1;
property Laser: MPLaserControl read Get_Laser;
end;
// *********************************************************************//
// DispIntf: IMultiphotonDisp
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {528196B3-544E-4C91-A526-2FE2AA21333D}
// *********************************************************************//
IMultiphotonDisp = dispinterface
['{528196B3-544E-4C91-A526-2FE2AA21333D}']
procedure AddFileProperty(const propname: WideString; const propvalue: WideString); dispid 1;
property FileComments: WideString writeonly dispid 3;
property Laser_Shutter: MPLaserShutter readonly dispid 4;
procedure LoadConfiguration(const configName: WideString); dispid 6;
procedure SetLaserBeamTo(X: Integer; Y: Integer); dispid 8;
procedure StartDigitalStim; dispid 9;
procedure StopDigitalStimulation; dispid 10;
procedure StartScan; dispid 11;
procedure StopScan; dispid 12;
procedure StartStreaming; dispid 13;
procedure StopStreaming; dispid 14;
procedure SetDigitalBit(digitalline: Integer; digitalvalue: Integer); dispid 15;
procedure NewDataFile(const filename: WideString); dispid 16;
procedure Wait(mscount: Integer); dispid 17;
property LastFrameIndex: Integer readonly dispid 25;
property matlab: MPMatlab readonly dispid 5;
property XY_Table: MPXYTable readonly dispid 18;
property Z_Stepper: MPZStepper readonly dispid 19;
property Scanning: Integer readonly dispid 7;
procedure DoEvents; dispid 20;
property YScanOffset: Integer dispid 21;
procedure EndScript; dispid 22;
property GPCTR0: MPCounter readonly dispid 26;
property GPCTR1: MPCounter readonly dispid 27;
property Laser: MPLaserControl readonly dispid 28;
procedure LoadDigitalStim(const digitalstimFile: WideString); dispid 201;
procedure WriteMessage(const Param1: WideString); dispid 202;
end;
// *********************************************************************//
// Interface: IMPLaserShutter
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {637AD17F-5D45-40AE-9759-2CCD019F6CD2}
// *********************************************************************//
IMPLaserShutter = interface(IDispatch)
['{637AD17F-5D45-40AE-9759-2CCD019F6CD2}']
procedure Close; safecall;
procedure Open; safecall;
end;
// *********************************************************************//
// DispIntf: IMPLaserShutterDisp
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {637AD17F-5D45-40AE-9759-2CCD019F6CD2}
// *********************************************************************//
IMPLaserShutterDisp = dispinterface
['{637AD17F-5D45-40AE-9759-2CCD019F6CD2}']
procedure Close; dispid 1;
procedure Open; dispid 2;
end;
// *********************************************************************//
// DispIntf: IMultiphotonEvents
// Flags: (4096) Dispatchable
// GUID: {7E98D2E3-6D6C-4272-A726-D0E083CC2367}
// *********************************************************************//
IMultiphotonEvents = dispinterface
['{7E98D2E3-6D6C-4272-A726-D0E083CC2367}']
procedure OnBtn1Clicked(const mpapp: IMultiphoton); dispid 1;
procedure OnBtn2Clicked(const mpapp: IMultiphoton); dispid 2;
procedure OnBtn3Clicked(const mpapp: IMultiphoton); dispid 3;
end;
// *********************************************************************//
// Interface: IMPXYTable
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {C66DFBD1-03E6-4E52-84E9-CA6F0C64E6F9}
// *********************************************************************//
IMPXYTable = interface(IDispatch)
['{C66DFBD1-03E6-4E52-84E9-CA6F0C64E6F9}']
procedure MoveToXY(X: Integer; Y: Integer); safecall;
procedure ShiftByXY(deltaX: Integer; deltaY: Integer); safecall;
function Get_XPosition: Integer; safecall;
function Get_YPosition: Integer; safecall;
procedure XYCommand(const sCommand: WideString); safecall;
function Get_XYSpeed: Integer; safecall;
procedure Set_XYSpeed(Value: Integer); safecall;
procedure GalilCall(const sCommand: WideString); safecall;
procedure GalilWaitForMotionComplete; safecall;
procedure sDMCCmd(const sCommand: WideString); safecall;
procedure sDMCWait(const sAxes: WideString); safecall;
procedure sSetDMCTimeout(timeout: Integer); safecall;
function Get_Reply: WideString; safecall;
procedure Set_Reply(const Value: WideString); safecall;
property XPosition: Integer read Get_XPosition;
property YPosition: Integer read Get_YPosition;
property XYSpeed: Integer read Get_XYSpeed write Set_XYSpeed;
property Reply: WideString read Get_Reply write Set_Reply;
end;
// *********************************************************************//
// DispIntf: IMPXYTableDisp
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {C66DFBD1-03E6-4E52-84E9-CA6F0C64E6F9}
// *********************************************************************//
IMPXYTableDisp = dispinterface
['{C66DFBD1-03E6-4E52-84E9-CA6F0C64E6F9}']
procedure MoveToXY(X: Integer; Y: Integer); dispid 1;
procedure ShiftByXY(deltaX: Integer; deltaY: Integer); dispid 3;
property XPosition: Integer readonly dispid 7;
property YPosition: Integer readonly dispid 8;
procedure XYCommand(const sCommand: WideString); dispid 2;
property XYSpeed: Integer dispid 4;
procedure GalilCall(const sCommand: WideString); dispid 201;
procedure GalilWaitForMotionComplete; dispid 202;
procedure sDMCCmd(const sCommand: WideString); dispid 203;
procedure sDMCWait(const sAxes: WideString); dispid 204;
procedure sSetDMCTimeout(timeout: Integer); dispid 205;
property Reply: WideString dispid 206;
end;
// *********************************************************************//
// Interface: IMPZStepper
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {C6A2E09D-B249-4564-9DC8-5FBE10FCB8EF}
// *********************************************************************//
IMPZStepper = interface(IDispatch)
['{C6A2E09D-B249-4564-9DC8-5FBE10FCB8EF}']
procedure MoveTo(z: Double); safecall;
procedure ShiftByZ(deltaZ: Double); safecall;
function Get_ZPosition: Double; safecall;
function Get_ZSpeed: Double; safecall;
procedure Set_ZSpeed(Value: Double); safecall;
property ZPosition: Double read Get_ZPosition;
property ZSpeed: Double read Get_ZSpeed write Set_ZSpeed;
end;
// *********************************************************************//
// DispIntf: IMPZStepperDisp
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {C6A2E09D-B249-4564-9DC8-5FBE10FCB8EF}
// *********************************************************************//
IMPZStepperDisp = dispinterface
['{C6A2E09D-B249-4564-9DC8-5FBE10FCB8EF}']
procedure MoveTo(z: Double); dispid 2;
procedure ShiftByZ(deltaZ: Double); dispid 3;
property ZPosition: Double readonly dispid 1;
property ZSpeed: Double dispid 4;
end;
// *********************************************************************//
// Interface: IMatlab
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {AA58FC68-0FA8-4327-8B53-888ABAD56938}
// *********************************************************************//
IMatlab = interface(IDispatch)
['{AA58FC68-0FA8-4327-8B53-888ABAD56938}']
procedure Start; safecall;
procedure PutROI(ROIIndex: Integer; const ArrayName: WideString); safecall;
procedure Execute(const mcommand: WideString); safecall;
end;
// *********************************************************************//
// DispIntf: IMatlabDisp
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {AA58FC68-0FA8-4327-8B53-888ABAD56938}
// *********************************************************************//
IMatlabDisp = dispinterface
['{AA58FC68-0FA8-4327-8B53-888ABAD56938}']
procedure Start; dispid 1;
procedure PutROI(ROIIndex: Integer; const ArrayName: WideString); dispid 2;
procedure Execute(const mcommand: WideString); dispid 3;
end;
// *********************************************************************//
// Interface: IMPCounter
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {A69A0D54-D5DD-4EF3-A1CC-6950148116B6}
// *********************************************************************//
IMPCounter = interface(IDispatch)
['{A69A0D54-D5DD-4EF3-A1CC-6950148116B6}']
procedure Change_Parameter(paramID: Integer; paramValue: Integer); safecall;
procedure Control(action: Integer); safecall;
procedure Set_Application(application: Integer); safecall;
procedure Select_Signal(polarity: Integer); safecall;
procedure Set_Count_1(Param1: Integer); safecall;
procedure Set_Count_2(Param1: Integer); safecall;
procedure Reset; safecall;
procedure Start; safecall;
function Watch(entityID: Integer): Integer; safecall;
procedure Set_CounterIndex(Param1: Integer); safecall;
procedure Set_Count_3(Param1: Integer); safecall;
procedure Set_Count_4(Param1: Integer); safecall;
property Count_1: Integer write Set_Count_1;
property Count_2: Integer write Set_Count_2;
property CounterIndex: Integer write Set_CounterIndex;
property Count_3: Integer write Set_Count_3;
property Count_4: Integer write Set_Count_4;
end;
// *********************************************************************//
// DispIntf: IMPCounterDisp
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {A69A0D54-D5DD-4EF3-A1CC-6950148116B6}
// *********************************************************************//
IMPCounterDisp = dispinterface
['{A69A0D54-D5DD-4EF3-A1CC-6950148116B6}']
procedure Change_Parameter(paramID: Integer; paramValue: Integer); dispid 1;
procedure Control(action: Integer); dispid 2;
procedure Set_Application(application: Integer); dispid 3;
procedure Select_Signal(polarity: Integer); dispid 4;
property Count_1: Integer writeonly dispid 5;
property Count_2: Integer writeonly dispid 6;
procedure Reset; dispid 7;
procedure Start; dispid 8;
function Watch(entityID: Integer): Integer; dispid 9;
property CounterIndex: Integer writeonly dispid 10;
property Count_3: Integer writeonly dispid 13;
property Count_4: Integer writeonly dispid 14;
end;
// *********************************************************************//
// Interface: IMPLaserControl
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {A4CE28BD-F4AB-4395-8A32-A8C86FD9B56F}
// *********************************************************************//
IMPLaserControl = interface(IDispatch)
['{A4CE28BD-F4AB-4395-8A32-A8C86FD9B56F}']
function Get_Power: Integer; safecall;
procedure Set_Power(Value: Integer); safecall;
function Get_Wavelength: Integer; safecall;
procedure Set_Wavelength(Value: Integer); safecall;
property Power: Integer read Get_Power write Set_Power;
property Wavelength: Integer read Get_Wavelength write Set_Wavelength;
end;
// *********************************************************************//
// DispIntf: IMPLaserControlDisp
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {A4CE28BD-F4AB-4395-8A32-A8C86FD9B56F}
// *********************************************************************//
IMPLaserControlDisp = dispinterface
['{A4CE28BD-F4AB-4395-8A32-A8C86FD9B56F}']
property Power: Integer dispid 1;
property Wavelength: Integer dispid 2;
end;
// *********************************************************************//
// The Class CoMultiPhoton provides a Create and CreateRemote method to
// create instances of the default interface IMultiphoton exposed by
// the CoClass MultiPhoton. The functions are intended to be used by
// clients wishing to automate the CoClass objects exposed by the
// server of this typelibrary.
// *********************************************************************//
CoMultiPhoton = class
class function Create: IMultiphoton;
class function CreateRemote(const MachineName: string): IMultiphoton;
end;
// *********************************************************************//
// The Class CoMPLaserShutter provides a Create and CreateRemote method to
// create instances of the default interface IMPLaserShutter exposed by
// the CoClass MPLaserShutter. The functions are intended to be used by
// clients wishing to automate the CoClass objects exposed by the
// server of this typelibrary.
// *********************************************************************//
CoMPLaserShutter = class
class function Create: IMPLaserShutter;
class function CreateRemote(const MachineName: string): IMPLaserShutter;
end;
// *********************************************************************//
// The Class CoMPXYTable provides a Create and CreateRemote method to
// create instances of the default interface IMPXYTable exposed by
// the CoClass MPXYTable. The functions are intended to be used by
// clients wishing to automate the CoClass objects exposed by the
// server of this typelibrary.
// *********************************************************************//
CoMPXYTable = class
class function Create: IMPXYTable;
class function CreateRemote(const MachineName: string): IMPXYTable;
end;
// *********************************************************************//
// The Class CoMPZStepper provides a Create and CreateRemote method to
// create instances of the default interface IMPZStepper exposed by
// the CoClass MPZStepper. The functions are intended to be used by
// clients wishing to automate the CoClass objects exposed by the
// server of this typelibrary.
// *********************************************************************//
CoMPZStepper = class
class function Create: IMPZStepper;
class function CreateRemote(const MachineName: string): IMPZStepper;
end;
// *********************************************************************//
// The Class CoMPMatlab provides a Create and CreateRemote method to
// create instances of the default interface IMatlab exposed by
// the CoClass MPMatlab. The functions are intended to be used by
// clients wishing to automate the CoClass objects exposed by the
// server of this typelibrary.
// *********************************************************************//
CoMPMatlab = class
class function Create: IMatlab;
class function CreateRemote(const MachineName: string): IMatlab;
end;
// *********************************************************************//
// The Class CoMPCounter provides a Create and CreateRemote method to
// create instances of the default interface IMPCounter exposed by
// the CoClass MPCounter. The functions are intended to be used by
// clients wishing to automate the CoClass objects exposed by the
// server of this typelibrary.
// *********************************************************************//
CoMPCounter = class
class function Create: IMPCounter;
class function CreateRemote(const MachineName: string): IMPCounter;
end;
// *********************************************************************//
// The Class CoMPLaserControl provides a Create and CreateRemote method to
// create instances of the default interface IMPLaserControl exposed by
// the CoClass MPLaserControl. The functions are intended to be used by
// clients wishing to automate the CoClass objects exposed by the
// server of this typelibrary.
// *********************************************************************//
CoMPLaserControl = class
class function Create: IMPLaserControl;
class function CreateRemote(const MachineName: string): IMPLaserControl;
end;
implementation
uses ComObj;
class function CoMultiPhoton.Create: IMultiphoton;
begin
Result := CreateComObject(CLASS_MultiPhoton) as IMultiphoton;
end;
class function CoMultiPhoton.CreateRemote(const MachineName: string): IMultiphoton;
begin
Result := CreateRemoteComObject(MachineName, CLASS_MultiPhoton) as IMultiphoton;
end;
class function CoMPLaserShutter.Create: IMPLaserShutter;
begin
Result := CreateComObject(CLASS_MPLaserShutter) as IMPLaserShutter;
end;
class function CoMPLaserShutter.CreateRemote(const MachineName: string): IMPLaserShutter;
begin
Result := CreateRemoteComObject(MachineName, CLASS_MPLaserShutter) as IMPLaserShutter;
end;
class function CoMPXYTable.Create: IMPXYTable;
begin
Result := CreateComObject(CLASS_MPXYTable) as IMPXYTable;
end;
class function CoMPXYTable.CreateRemote(const MachineName: string): IMPXYTable;
begin
Result := CreateRemoteComObject(MachineName, CLASS_MPXYTable) as IMPXYTable;
end;
class function CoMPZStepper.Create: IMPZStepper;
begin
Result := CreateComObject(CLASS_MPZStepper) as IMPZStepper;
end;
class function CoMPZStepper.CreateRemote(const MachineName: string): IMPZStepper;
begin
Result := CreateRemoteComObject(MachineName, CLASS_MPZStepper) as IMPZStepper;
end;
class function CoMPMatlab.Create: IMatlab;
begin
Result := CreateComObject(CLASS_MPMatlab) as IMatlab;
end;
class function CoMPMatlab.CreateRemote(const MachineName: string): IMatlab;
begin
Result := CreateRemoteComObject(MachineName, CLASS_MPMatlab) as IMatlab;
end;
class function CoMPCounter.Create: IMPCounter;
begin
Result := CreateComObject(CLASS_MPCounter) as IMPCounter;
end;
class function CoMPCounter.CreateRemote(const MachineName: string): IMPCounter;
begin
Result := CreateRemoteComObject(MachineName, CLASS_MPCounter) as IMPCounter;
end;
class function CoMPLaserControl.Create: IMPLaserControl;
begin
Result := CreateComObject(CLASS_MPLaserControl) as IMPLaserControl;
end;
class function CoMPLaserControl.CreateRemote(const MachineName: string): IMPLaserControl;
begin
Result := CreateRemoteComObject(MachineName, CLASS_MPLaserControl) as IMPLaserControl;
end;
end.
Raw
NIDAQ
{
***************************************************************************
NI-DAQ Header file for Borland Delphi (32-bit)
Copyright (C) National Instruments 2000.
***************************************************************************
}
unit NIDAQ;
interface
uses Windows;
{ special types }
type
i8 = ShortInt;
type
u8 = Byte;
type
pi8 = PChar;
type
i16 = SmallInt;
type
u16 = Word;
type
pi16 = ^i16;
type
pu16 = ^u16;
type
i32 = LongInt;
type
u32 = Cardinal;
type
pi32 = ^i32;
type
pu32 = ^u32;
type
f32 = Single;
type
f64 = Double;
type
pf64 = ^f64;
type
nidaqStatus = i16;
const
nidaqdll = 'nidaq32.dll';
{ NI-DAQ function prototypes }
function AI_Change_Parameter (
slot: i16;
channel: i16;
paramID: u32;
paramValue: u32
):nidaqStatus; stdcall; external nidaqdll;
function AI_Check (
slot: i16;
status: pi16;
value: pi16
):nidaqStatus; stdcall; external nidaqdll;
function AI_Clear (
slot: i16
):nidaqStatus; stdcall; external nidaqdll;
function AI_Configure (
slot: i16;
chan: i16;
inputMode: i16;
inputRange: i16;
polarity: i16;
driveAIS: i16
):nidaqStatus; stdcall; external nidaqdll;
function AI_Mux_Config (
slot: i16;
numMuxBrds: i16
):nidaqStatus; stdcall; external nidaqdll;
function AI_Read (
slot: i16;
chan: i16;
gain: i16;
value: pi16
):nidaqStatus; stdcall; external nidaqdll;
function AI_Setup (
slot: i16;
chan: i16;
gain: i16
):nidaqStatus; stdcall; external nidaqdll;
function AI_VRead (
slot: i16;
chan: i16;
gain: i16;
volts: pf64
):nidaqStatus; stdcall; external nidaqdll;
function AI_VScale (
slot: i16;
chan: i16;
gain: i16;
gainAdjust: f64;
offset: f64;
reading: i16;
voltage: pf64
):nidaqStatus; stdcall; external nidaqdll;
function Align_DMA_Buffer (
slot: i16;
resource: i16;
buffer: pi16;
cnt: u32;
bufSize: u32;
alignIndex: pu32
):nidaqStatus; stdcall; external nidaqdll;
function AO_Calibrate (
board: i16;
operation: i16;
EEPROMloc: i16
):nidaqStatus; stdcall; external nidaqdll;
function AO_Configure (
slot: i16;
chan: i16;
outputPolarity: i16;
IntOrExtRef: i16;
refVoltage: f64;
updateMode: i16
):nidaqStatus; stdcall; external nidaqdll;
function AO_Change_Parameter (
slot: i16;
channel: i16;
paramID: u32;
paramValue: u32
):nidaqStatus; stdcall; external nidaqdll;
function AO_Update (
slot: i16
):nidaqStatus; stdcall; external nidaqdll;
function AO_VWrite (
slot: i16;
chan: i16;
voltage: f64
):nidaqStatus; stdcall; external nidaqdll;
function AO_Write (
slot: i16;
chan: i16;
value: i16
):nidaqStatus; stdcall; external nidaqdll;
function Calibrate_E_Series (
deviceNumber: i16;
calOp: u32;
setOfCalConst: u32;
calRefVolts: f64
):nidaqStatus; stdcall; external nidaqdll;
function Calibrate_59xx (
deviceNumber: i16;
operation: u32;
refVoltage: f64
):nidaqStatus; stdcall; external nidaqdll;
function Calibrate_DSA (
deviceNumber: i16;
operation: u32;
refVoltage: f64
):nidaqStatus; stdcall; external nidaqdll;
function Config_Alarm_Deadband (
slot: i16;
mode: i16;
chanStr: pi8;
trigLvl: f64;
deadbandWidth: f64;
handle: HWND;
alarmOnMsg: i16;
alarmOffMsg: i16;
callbackAddr: u32
):nidaqStatus; stdcall; external nidaqdll;
function Config_ATrig_Event_Message (
slot: i16;
mode: i16;
chanStr: pi8;
trigLvl: f64;
winSize: f64;
trigSlope: i16;
skipCnt: u32;
preTrigScans: u32;
postTrigScans: u32;
handle: HWND;
msg: i16;
callBackAddr: u32
):nidaqStatus; stdcall; external nidaqdll;
function Config_DAQ_Event_Message (
slot: i16;
mode: i16;
chanStr: pi8;
DAQEvent: i16;
trigVal0: i32;
trigVal1: i32;
skipCnt: u32;
preTrigScans: u32;
postTrigScans: u32;
handle: HWND;
msg: i16;
callBackAddr: u32
):nidaqStatus; stdcall; external nidaqdll;
function Configure_HW_Analog_Trigger (
deviceNumber: i16;
onOrOff: u32;
lowValue: i32;
highValue: i32;
mode: u32;
trigSource: u32
):nidaqStatus; stdcall; external nidaqdll;
function CTR_Config (
slot: i16;
ctr: i16;
edgeMode: i16;
gateMode: i16;
outType: i16;
outPolarity: i16
):nidaqStatus; stdcall; external nidaqdll;
function CTR_EvCount (
slot: i16;
ctr: i16;
timebase: i16;
cont: i16
):nidaqStatus; stdcall; external nidaqdll;
function CTR_EvRead (
slot: i16;
ctr: i16;
overflow: pi16;
counts: pu16
):nidaqStatus; stdcall; external nidaqdll;
function CTR_FOUT_Config (
slot: i16;
FOUT: i16;
mode: i16;
timebase: i16;
division: i16
):nidaqStatus; stdcall; external nidaqdll;
function CTR_Period (
slot: i16;
ctr: i16;
timebase: i16
):nidaqStatus; stdcall; external nidaqdll;
function CTR_Pulse (
slot: i16;
ctr: i16;
timebase: i16;
delay: u16;
pulseWidth: u16
):nidaqStatus; stdcall; external nidaqdll;
function CTR_Rate (
freq: f64;
duty: f64;
timebase: pi16;
period1: pu16;
period2: pu16
):nidaqStatus; stdcall; external nidaqdll;
function CTR_Reset (
slot: i16;
ctr: i16;
outState: i16
):nidaqStatus; stdcall; external nidaqdll;
function CTR_Restart (
slot: i16;
ctr: i16
):nidaqStatus; stdcall; external nidaqdll;
function CTR_Simul_Op (
slot: i16;
numCtrs: i16;
ctrList: pi16;
mode: i16
):nidaqStatus; stdcall; external nidaqdll;
function CTR_Square (
slot: i16;
ctr: i16;
timebase: i16;
period1: u16;
period2: u16
):nidaqStatus; stdcall; external nidaqdll;
function CTR_State (
slot: i16;
ctr: i16;
outState: pi16
):nidaqStatus; stdcall; external nidaqdll;
function CTR_Stop (
slot: i16;
ctr: i16
):nidaqStatus; stdcall; external nidaqdll;
function DAQ_Check (
slot: i16;
progress: pi16;
retrieved: pu32
):nidaqStatus; stdcall; external nidaqdll;
function DAQ_Clear (
slot: i16
):nidaqStatus; stdcall; external nidaqdll;
function DAQ_Config (
slot: i16;
startTrig: i16;
extConv: i16
):nidaqStatus; stdcall; external nidaqdll;
function DAQ_DB_Config (
slot: i16;
dbMode: i16
):nidaqStatus; stdcall; external nidaqdll;
function DAQ_DB_HalfReady (
slot: i16;
halfReady: pi16;
status: pi16
):nidaqStatus; stdcall; external nidaqdll;
function DAQ_DB_Transfer (
slot: i16;
hbuffer: pi16;
ptsTfr: pu32;
status: pi16
):nidaqStatus; stdcall; external nidaqdll;
function DAQ_Monitor (
slot: i16;
chan: i16;
seq: i16;
monitorCnt: u32;
monitorBuf: pi16;
newestIndex: pu32;
status: pi16
):nidaqStatus; stdcall; external nidaqdll;
function DAQ_Op (
slot: i16;
chan: i16;
gain: i16;
buffer: pi16;
cnt: u32;
sampleRate: f64
):nidaqStatus; stdcall; external nidaqdll;
function DAQ_Rate (
rate: f64;
units: i16;
timebase: pi16;
sampleInt: pu16
):nidaqStatus; stdcall; external nidaqdll;
function DAQ_Start (
slot: i16;
chan: i16;
gain: i16;
buffer: pi16;
cnt: u32;
timebase: i16;
sampInt: u16
):nidaqStatus; stdcall; external nidaqdll;
function DAQ_StopTrigger_Config (
slot: i16;
preTrig: i16;
preTrigCnt: u32
):nidaqStatus; stdcall; external nidaqdll;
function DAQ_to_Disk (
slot: i16;
chan: i16;
gain: i16;
fileName: pi8;
cnt: u32;
sampleRate: f64;
concat: i16
):nidaqStatus; stdcall; external nidaqdll;
function DAQ_VScale (
slot: i16;
chan: i16;
gain: i16;
gainAdjust: f64;
offset: f64;
cnt: u32;
binArray: pi16;
voltArray: pf64
):nidaqStatus; stdcall; external nidaqdll;
function DIG_Block_Check (
slot: i16;
grp: i16;
remaining: pu32
):nidaqStatus; stdcall; external nidaqdll;
function DIG_Block_Clear (
slot: i16;
grp: i16
):nidaqStatus; stdcall; external nidaqdll;
function DIG_Block_In (
slot: i16;
grp: i16;
buffer: pi16;
cnt: u32
):nidaqStatus; stdcall; external nidaqdll;
function DIG_Block_Out (
slot: i16;
grp: i16;
buffer: pi16;
cnt: u32
):nidaqStatus; stdcall; external nidaqdll;
function DIG_Block_PG_Config (
slot: i16;
grp: i16;
PGmode: i16;
reqSource: i16;
timebase: i16;
interval: u16;
externalGate: i16
):nidaqStatus; stdcall; external nidaqdll;
function DIG_DB_Config (
slot: i16;
grp: i16;
DBMode: i16;
oldDataStop: i16;
partialTransfer: i16
):nidaqStatus; stdcall; external nidaqdll;
function DIG_DB_HalfReady (
slot: i16;
grp: i16;
halfReady: pi16
):nidaqStatus; stdcall; external nidaqdll;
function DIG_DB_Transfer (
slot: i16;
grp: i16;
halfBuffer: pi16;
ptsTfr: u32
):nidaqStatus; stdcall; external nidaqdll;
function DIG_Grp_Config (
slot: i16;
grp: i16;
grpsize: i16;
port: i16;
direction: i16
):nidaqStatus; stdcall; external nidaqdll;
function DIG_Grp_Mode (
slot: i16;
grp: i16;
sigType: i16;
edge: i16;
reqpol: i16;
ackpol: i16;
settleTime: i16
):nidaqStatus; stdcall; external nidaqdll;
function DIG_Grp_Status (
slot: i16;
grp: i16;
status: pi16
):nidaqStatus; stdcall; external nidaqdll;
function DIG_In_Grp (
slot: i16;
grp: i16;
grp_pat: pi16
):nidaqStatus; stdcall; external nidaqdll;
function DIG_In_Line (
slot: i16;
port: i16;
linenum: i16;
state: pi16
):nidaqStatus; stdcall; external nidaqdll;
function DIG_In_Port (
slot: i16;
port: i16;
pattern: pi16
):nidaqStatus; stdcall; external nidaqdll;
function DIG_Line_Config (
slot: i16;
port: i16;
linenum: i16;
direction: i16
):nidaqStatus; stdcall; external nidaqdll;
function DIG_Out_Grp (
slot: i16;
grp: i16;
grp_pat: i16
):nidaqStatus; stdcall; external nidaqdll;
function DIG_Out_Line (
slot: i16;
port: i16;
linenum: i16;
state: i16
):nidaqStatus; stdcall; external nidaqdll;
function DIG_Out_Port (
slot: i16;
port: i16;
pattern: i16
):nidaqStatus; stdcall; external nidaqdll;
function DIG_Prt_Config (
slot: i16;
port: i16;
latch_mode: i16;
direction: i16
):nidaqStatus; stdcall; external nidaqdll;
function DIG_Prt_Status (
slot: i16;
port: i16;
status: pi16
):nidaqStatus; stdcall; external nidaqdll;
function DIG_SCAN_Setup (
slot: i16;
grp: i16;
numPorts: i16;
portList: pi16;
direction: i16
):nidaqStatus; stdcall; external nidaqdll;
function Get_DAQ_Device_Info (
deviceNumber: i16;
infoType: u32;
infoVal: pu32
):nidaqStatus; stdcall; external nidaqdll;
function Get_DAQ_Event (
timeOut: u32;
handle: pi16;
msg: pi16;
wParam: pi16;
lParam: pi32
):nidaqStatus; stdcall; external nidaqdll;
function Get_NI_DAQ_Version (
version: pu32
):nidaqStatus; stdcall; external nidaqdll;
function GPCTR_Config_Buffer (
deviceNumber: i16;
gpCounterNumber: u32;
reserved: u32;
numPoints: u32;
buffer: pu32
):nidaqStatus; stdcall; external nidaqdll;
function GPCTR_Read_Buffer (
deviceNumber: i16;
gpCounterNumber: u32;
readMode: u32;
readOffset: i32;
numPointsToRead: u32;
timeOut: f64;
numPointsRead: pu32;
buffer: pu32
):nidaqStatus; stdcall; external nidaqdll;
function Line_Change_Attribute (
deviceNumber: i16;
lineNumber: u32;
attribID: u32;
attribValue: u32
):nidaqStatus; stdcall; external nidaqdll;
function GPCTR_Control (
deviceNumber: i16;
gpCounterNumber: u32;
action: u32
):nidaqStatus; stdcall; external nidaqdll;
function GPCTR_Set_Application (
deviceNumber: i16;
gpCounterNumber: u32;
application: u32
):nidaqStatus; stdcall; external nidaqdll;
function GPCTR_Watch (
deviceNumber: i16;
gpCounterNumber: u32;
watchID: u32;
watchValue: pu32
):nidaqStatus; stdcall; external nidaqdll;
function ICTR_Read (
slot: i16;
counter: i16;
cnt: pu16
):nidaqStatus; stdcall; external nidaqdll;
function ICTR_Reset (
slot: i16;
counter: i16;
state: i16
):nidaqStatus; stdcall; external nidaqdll;
function ICTR_Setup (
slot: i16;
counter: i16;
mode: i16;
cnt: u16;
binBCD: i16
):nidaqStatus; stdcall; external nidaqdll;
function Init_DA_Brds (
slot: i16;
brdCode: pi16
):nidaqStatus; stdcall; external nidaqdll;
function Lab_ISCAN_Check (
slot: i16;
status: pi16;
retrieved: pu32;
finalScanOrder: pi16
):nidaqStatus; stdcall; external nidaqdll;
function Lab_ISCAN_Op (
slot: i16;
numChans: i16;
gain: i16;
buffer: pi16;
cnt: u32;
sampleRate: f64;
scanRate: f64;
finalScanOrder: pi16
):nidaqStatus; stdcall; external nidaqdll;
function Lab_ISCAN_Start (
slot: i16;
numChans: i16;
gain: i16;
buffer: pi16;
cnt: u32;
timebase: i16;
sampleInt: u16;
scanInt: u16
):nidaqStatus; stdcall; external nidaqdll;
function Lab_ISCAN_to_Disk (
slot: i16;
numChans: i16;
gain: i16;
fileName: pi8;
cnt: u32;
sampleRate: f64;
scanRate: f64;
concat: i16
):nidaqStatus; stdcall; external nidaqdll;
function LPM16_Calibrate (
slot: i16
):nidaqStatus; stdcall; external nidaqdll;
function MIO_Config (
slot: i16;
dither: i16;
useAMUX: i16
):nidaqStatus; stdcall; external nidaqdll;
function Peek_DAQ_Event (
timeOut: u32;
handle: pi16;
msg: pi16;
wParam: pi16;
lParam: pi32
):nidaqStatus; stdcall; external nidaqdll;
function REG_Level_Read (
slot: i16;
registerIndex: i16;
registerValue: pu32
):nidaqStatus; stdcall; external nidaqdll;
function REG_Level_Write (
slot: i16;
registerIndex: i16;
bitsAffected: u32;
bitSettings: u32;
registerValue: pu32
):nidaqStatus; stdcall; external nidaqdll;
function RTSI_Clear (
slot: i16
):nidaqStatus; stdcall; external nidaqdll;
function RTSI_Clock (
slot: i16;
connect: i16;
direction: i16
):nidaqStatus; stdcall; external nidaqdll;
function RTSI_Conn (
slot: i16;
brdSignal: i16;
busLine: i16;
direction: i16
):nidaqStatus; stdcall; external nidaqdll;
function RTSI_DisConn (
slot: i16;
brdSignal: i16;
busLine: i16
):nidaqStatus; stdcall; external nidaqdll;
function SC_2040_Config (
deviceNumber: i16;
channel: i16;
sc2040Gain: i16
):nidaqStatus; stdcall; external nidaqdll;
function SCAN_Demux (
buffer: pi16;
cnt: u32;
numChans: i16;
muxMode: i16
):nidaqStatus; stdcall; external nidaqdll;
function SCAN_Op (
slot: i16;
numChans: i16;
chans: pi16;
gains: pi16;
buffer: pi16;
cnt: u32;
sampleRate: f64;
scanRate: f64
):nidaqStatus; stdcall; external nidaqdll;
function SCAN_Sequence_Demux (
numChans: i16;
chanVector: pi16;
bufferSize: u32;
buffer: pi16;
samplesPerSequence: i16;
scanSequenceVector: pi16;
samplesPerChanVector: pu32
):nidaqStatus; stdcall; external nidaqdll;
function SCAN_Sequence_Retrieve (
deviceNumber: i16;
samplesPerSequence: i16;
scanSequenceVector: pi16
):nidaqStatus; stdcall; external nidaqdll;
function SCAN_Sequence_Setup (
deviceNumber: i16;
numChans: i16;
chanVector: pi16;
gainVector: pi16;
scanRateDivVector: pi16;
scansPerSequence: pi16;
samplesPerSequence: pi16
):nidaqStatus; stdcall; external nidaqdll;
function SCAN_Setup (
slot: i16;
num_chans: i16;
chans: pi16;
gains: pi16
):nidaqStatus; stdcall; external nidaqdll;
function SCAN_Start (
slot: i16;
buffer: pi16;
cnt: u32;
tb1: i16;
si1: u16;
tb2: i16;
si2: u16
):nidaqStatus; stdcall; external nidaqdll;
function SCAN_to_Disk (
slot: i16;
numChans: i16;
chans: pi16;
gains: pi16;
fileName: pi8;
cnt: u32;
sampleRate: f64;
scanRate: f64;
concat: i16
):nidaqStatus; stdcall; external nidaqdll;
function Calibrate_1200 (
deviceNumber: i16;
calOP: i16;
saveNewCal: i16;
EEPROMloc: i16;
calRefChan: i16;
grndRefChan: i16;
DAC0chan: i16;
DAC1chan: i16;
calRefVolts: f64;
gain: f64
):nidaqStatus; stdcall; external nidaqdll;
function SCXI_AO_Write (
chassisID: i16;
moduleSlot: i16;
DACchannel: i16;
opCode: i16;
rangeCode: i16;
voltCurrentData: f64;
binaryDat: i16;
binaryWritten: pi16
):nidaqStatus; stdcall; external nidaqdll;
function SCXI_Cal_Constants (
chassisID: i16;
moduleSlot: i16;
SCXIchannel: i16;
operation: i16;
calArea: i16;
rangeCode: i16;
SCXIgain: f64;
DAQdevice: i16;
DAQchannel: i16;
DAQgain: i16;
TBgain: f64;
volt1: f64;
binary1: f64;
volt2: f64;
binary2: f64;
binEEprom1: pf64;
binEEprom2: pf64
):nidaqStatus; stdcall; external nidaqdll;
function SCXI_Calibrate (
chassisID: i16;
moduleSlot: i16;
moduleChan: i16;
operation: i16;
calArea: i16;
SCXIgain: f64;
inputRefVoltage: f64;
DAQdevice: i16;
DAQchan: i16
):nidaqStatus; stdcall; external nidaqdll;
function SCXI_Strain_Null (
chassisID: i16;
slot: i16;
moduleChan: i16;
device: i16;
DAQchan: i16;
imbalances: pu32
):nidaqStatus; stdcall; external nidaqdll;
function SCXI_Calibrate_Setup (
chassisID: i16;
moduleSlot: i16;
calOp: i16
):nidaqStatus; stdcall; external nidaqdll;
function SCXI_Change_Chan (
chassisID: i16;
moduleSlot: i16;
chan: i16
):nidaqStatus; stdcall; external nidaqdll;
function SCXI_Set_Excitation (
chassisID: i16;
moduleSlot: i16;
channel: i16;
excitationType: i16;
excitation: f32;
actualExcitation: pu32
):nidaqStatus; stdcall; external nidaqdll;
function SCXI_Configure_Connection (
chassisID: i16;
moduleSlot: i16;
channel: i16;
connectionType: i16
):nidaqStatus; stdcall; external nidaqdll;
function SCXI_Configure_Filter (
chassisID: i16;
moduleSlot: i16;
channel: i16;
filterMode: i16;
freq: f64;
cutoffDivDown: u16;
outClkDivDown: u16;
actFreq: pf64
):nidaqStatus; stdcall; external nidaqdll;
function SCXI_Get_Chassis_Info (
chassisID: i16;
chassisType: pi16;
address: pi16;
commMode: pi16;
commPath: pi16;
numSlots: pi16
):nidaqStatus; stdcall; external nidaqdll;
function SCXI_Get_Module_Info (
chassisID: i16;
slot: i16;
modulePresent: pi32;
opMode: pi16;
DAQboard: pi16
):nidaqStatus; stdcall; external nidaqdll;
function SCXI_Get_State (
chassisID: i16;
moduleSlot: i16;
port: i16;
channel: i16;
data: pu32
):nidaqStatus; stdcall; external nidaqdll;
function SCXI_Get_Status (
chassisID: i16;
moduleSlot: i16;
wait: i16;
data: pu32
):nidaqStatus; stdcall; external nidaqdll;
function SCXI_Load_Config (
chassisID: i16
):nidaqStatus; stdcall; external nidaqdll;
function SCXI_MuxCtr_Setup (
slot: i16;
enable: i16;
scanDiv: i16;
muxCtrVal: u16
):nidaqStatus; stdcall; external nidaqdll;
function SCXI_Reset (
chassisID: i16;
moduleSlot: i16
):nidaqStatus; stdcall; external nidaqdll;
function SCXI_Scale (
chassisID: i16;
moduleSlot: i16;
SCXIchannel: i16;
SCXIgain: f64;
TBgain: f64;
DAQdevice: i16;
DAQchannel: i16;
DAQgain: i16;
numPoints: u32;
binArray: pi16;
voltArray: pf64
):nidaqStatus; stdcall; external nidaqdll;
function SCXI_SCAN_Setup (
chassisID: i16;
numModules: i16;
modules: pi16;
numChans: pi16;
startChans: pi16;
DAQboard: i16;
modeFlag: i16
):nidaqStatus; stdcall; external nidaqdll;
function SCXI_Set_Config (
chassisID: i16;
chassisType: i16;
address: i16;
commMode: i16;
slotOrCOMM: i16;
numSlots: i16;
moduleTypes: pi32;
opModes: pi16;
DAQboards: pi16
):nidaqStatus; stdcall; external nidaqdll;
function SCXI_Set_Gain (
chassisID: i16;
moduleSlot: i16;
channel: i16;
gain: f64
):nidaqStatus; stdcall; external nidaqdll;
function SCXI_Set_Input_Mode (
chassisID: i16;
moduleSlot: i16;
inputMode: i16
):nidaqStatus; stdcall; external nidaqdll;
function SCXI_Set_State (
chassisID: i16;
moduleSlot: i16;
port: i16;
channel: i16;
data: u32
):nidaqStatus; stdcall; external nidaqdll;
function SCXI_Single_Chan_Setup (
chassisID: i16;
moduleSlot: i16;
chan: i16;
DAQboard: i16
):nidaqStatus; stdcall; external nidaqdll;
function SCXI_Track_Hold_Control (
chassisID: i16;
moduleSlot: i16;
state: i16;
DAQboard: i16
):nidaqStatus; stdcall; external nidaqdll;
function SCXI_Track_Hold_Setup (
chassisID: i16;
moduleSlot: i16;
mode: i16;
source: i16;
send: i16;
holdCnt: i16;
DAQboard: i16
):nidaqStatus; stdcall; external nidaqdll;
function Select_Signal (
deviceNumber: i16;
signal: u32;
source: u32;
sourceSpec: u32
):nidaqStatus; stdcall; external nidaqdll;
function Set_DAQ_Device_Info (
deviceNumber: i16;
infoType: u32;
infoVal: u32
):nidaqStatus; stdcall; external nidaqdll;
function Timeout_Config (
slot: i16;
numTicks: i32
):nidaqStatus; stdcall; external nidaqdll;
function WFM_Chan_Control (
slot: i16;
channel: i16;
operation: i16
):nidaqStatus; stdcall; external nidaqdll;
function WFM_Check (
slot: i16;
channel: i16;
progress: pi16;
itersDone: pu32;
pointsDone: pu32
):nidaqStatus; stdcall; external nidaqdll;
function WFM_ClockRate (
slot: i16;
group: i16;
whickClock: i16;
timebase: i16;
updateInterval: u32;
mode: i16
):nidaqStatus; stdcall; external nidaqdll;
function WFM_DB_Config (
slot: i16;
numChans: i16;
chanVect: pi16;
DBMode: i16;
oldDataStop: i16;
partialTransfer: i16
):nidaqStatus; stdcall; external nidaqdll;
function WFM_DB_HalfReady (
slot: i16;
numChans: i16;
chanVect: pi16;
halfReady: pi16
):nidaqStatus; stdcall; external nidaqdll;
function WFM_DB_Transfer (
slot: i16;
numChans: i16;
chanVect: pi16;
buffer: pi16;
cnt: u32
):nidaqStatus; stdcall; external nidaqdll;
function WFM_from_Disk (
slot: i16;
numChans: i16;
chanVect: pi16;
fileName: pi8;
startPts: u32;
endPts: u32;
iterations: u32;
rate: f64
):nidaqStatus; stdcall; external nidaqdll;
function WFM_Group_Control (
slot: i16;
group: i16;
operation: i16
):nidaqStatus; stdcall; external nidaqdll;
function WFM_Group_Setup (
slot: i16;
numChans: i16;
chanVect: pi16;
group: i16
):nidaqStatus; stdcall; external nidaqdll;
function WFM_Load (
slot: i16;
numChans: i16;
chanVect: pi16;
buffer: pi16;
cnt: u32;
iterations: u32;
mode: i16
):nidaqStatus; stdcall; external nidaqdll;
function WFM_Op (
slot: i16;
numChans: i16;
chanVect: pi16;
buffer: pi16;
cnt: u32;
iterations: u32;
rate: f64
):nidaqStatus; stdcall; external nidaqdll;
function WFM_Rate (
rate: f64;
units: i16;
timebase: pi16;
updateInterval: pu32
):nidaqStatus; stdcall; external nidaqdll;
function WFM_Scale (
slot: i16;
chan: i16;
cnt: u32;
gain: f64;
voltArray: pf64;
binArray: pi16
):nidaqStatus; stdcall; external nidaqdll;
function AI_Read_Scan (
slot: i16;
reading: pi16
):nidaqStatus; stdcall; external nidaqdll;
function AI_VRead_Scan (
slot: i16;
reading: pf64
):nidaqStatus; stdcall; external nidaqdll;
function SCXI_ModuleID_Read (
scxiID: i16;
moduleSlot: i16;
id: pi32
):nidaqStatus; stdcall; external nidaqdll;
function USE_E_Series
:nidaqStatus; stdcall; external nidaqdll;
function USE_E_Series_AI
:nidaqStatus; stdcall; external nidaqdll;
function USE_E_Series_AO
:nidaqStatus; stdcall; external nidaqdll;
function USE_E_Series_DIO
:nidaqStatus; stdcall; external nidaqdll;
function USE_E_Series_GPCTR
:nidaqStatus; stdcall; external nidaqdll;
function USE_E_Series_GPCTR_Simple
:nidaqStatus; stdcall; external nidaqdll;
function USE_E_Series_Misc
:nidaqStatus; stdcall; external nidaqdll;
function USE_E_Series_WFM
:nidaqStatus; stdcall; external nidaqdll;
function AO_VScale (
slot: i16;
chan: i16;
voltage: f64;
value: pi16
):nidaqStatus; stdcall; external nidaqdll;
function GPCTR_Change_Parameter (
deviceNumber: i16;
gpCounterNumber: u32;
paramID: u32;
paramValue: u32
):nidaqStatus; stdcall; external nidaqdll;
function USE_E_Series_DAQ
:nidaqStatus; stdcall; external nidaqdll;
function USE_MIO
:nidaqStatus; stdcall; external nidaqdll;
function USE_LPM
:nidaqStatus; stdcall; external nidaqdll;
function USE_LAB
:nidaqStatus; stdcall; external nidaqdll;
function USE_DIO_96
:nidaqStatus; stdcall; external nidaqdll;
function USE_DIO_32F
:nidaqStatus; stdcall; external nidaqdll;
function USE_DIO_24
:nidaqStatus; stdcall; external nidaqdll;
function USE_AO_610
:nidaqStatus; stdcall; external nidaqdll;
function USE_AO_2DC
:nidaqStatus; stdcall; external nidaqdll;
function DIG_Trigger_Config (
slot: i16;
grp: i16;
startTrig: i16;
startPol: i16;
stopTrig: i16;
stopPol: i16;
ptsAfterStopTrig: u32;
pattern: u32;
patternMask: u32
):nidaqStatus; stdcall; external nidaqdll;
function SCXI_Set_Threshold (
chassisID: i16;
moduleSlot: i16;
channel: i16;
threshHold: f64;
hysteresis: f64
):nidaqStatus; stdcall; external nidaqdll;
function WFM_Set_Clock (
slot: i16;
group: i16;
whichClock: u32;
desiredRate: f64;
units: u32;
actualRate: pf64
):nidaqStatus; stdcall; external nidaqdll;
function DAQ_Set_Clock (
slot: i16;
whichClock: u32;
desiredRate: f64;
units: u32;
actualRate: pf64
):nidaqStatus; stdcall; external nidaqdll;
function Tio_Select_Signal (
deviceNumber: i16;
signal: u32;
source: u32;
sourceSpec: u32
):nidaqStatus; stdcall; external nidaqdll;
function Tio_Combine_Signals (
deviceNumber: i16;
internalLine: u32;
logicalExpression: u32
):nidaqStatus; stdcall; external nidaqdll;
function DIG_In_Prt (
slot: i16;
port: i16;
pattern: pi32
):nidaqStatus; stdcall; external nidaqdll;
function DIG_Out_Prt (
slot: i16;
port: i16;
pattern: i32
):nidaqStatus; stdcall; external nidaqdll;
function AI_Get_Overloaded_Channels (
deviceNumber: i16;
numChannels: pi16;
channelList: pi16
):nidaqStatus; stdcall; external nidaqdll;
function Calibrate_TIO (
deviceNumber: i16;
operation: u32;
setOfCalConst: u32;
referenceFreq: f64
):nidaqStatus; stdcall; external nidaqdll;
function DIG_Change_Message_Config (
deviceNumber: i16;
operation: i16;
riseChanStr: pi8;
fallChanStr: pi8;
handle: HWND;
msg: i16;
callBackAddr: u32
):nidaqStatus; stdcall; external nidaqdll;
function DIG_Change_Message_Control (
deviceNumber: i16;
ctrlCode: i16
):nidaqStatus; stdcall; external nidaqdll;
function DIG_Filter_Config (
deviceNumber: i16;
mode: i16;
chanStr: pi8;
interval: f64
):nidaqStatus; stdcall; external nidaqdll;
implementation
end.
Raw
NIDAQCNS
(*********************************************************************)
(* *)
(* This file contains definitions for constants required for some *)
(* of the NI-DAQ functions. *)
(* *)
(* You should use symbols defined here in your programs; do not *)
(* use the numerical values. *)
(* *)
(* See your NI-DAQ Function Reference Manual for details concerning *)
(* use of constants defined here. *)
(* *)
(*********************************************************************)
unit NIDAQCNS;
interface
CONST ND_ABOVE_HIGH_LEVEL = 11020;
ND_AC = 11025;
ND_ACK_REQ_EXCHANGE_GR1 = 11030;
ND_ACK_REQ_EXCHANGE_GR2 = 11035;
ND_ACTIVE = 11037;
ND_ADC_RESOLUTION = 11040;
ND_AI_CALDAC_COUNT = 11050;
ND_AI_CHANNEL_COUNT = 11060;
ND_AI_COUPLING = 11055;
ND_AI_FIFO_INTERRUPTS = 11600;
ND_ANALOG_FILTER = 11065;
ND_AO48XDC_SET_POWERUP_STATE = 42100;
ND_AO_CALDAC_COUNT = 11070;
ND_AO_CHANNEL_COUNT = 11080;
ND_AO_EXT_REF_CAPABLE = 11090;
ND_AO_UNIPOLAR_CAPABLE = 11095;
ND_ARM = 11100;
ND_ARMED = 11200;
ND_ATC_OUT = 11250;
ND_ATTENUATION = 11260;
ND_AUTOINCREMENT_COUNT = 11300;
ND_AUTOMATIC = 11400;
ND_AVAILABLE_POINTS = 11500;
ND_BASE_ADDRESS = 12100;
ND_BELOW_LOW_LEVEL = 12130;
ND_BOARD_CLOCK = 12170;
ND_BUFFERED_EVENT_CNT = 12200;
ND_BUFFERED_PERIOD_MSR = 12300;
ND_BUFFERED_PULSE_WIDTH_MSR = 12400;
ND_BUFFERED_SEMI_PERIOD_MSR = 12500;
ND_BURST = 12600;
ND_BURST_INTERVAL = 12700;
ND_CAL_CONST_AUTO_LOAD = 13050;
ND_CALIBRATION_ENABLE = 13055;
ND_CALIBRATION_FRAME_SIZE = 13060;
ND_CALIBRATION_FRAME_PTR = 13065;
ND_CJ_TEMP = ($8000);
ND_CALGND = ($8001);
ND_CLEAN_UP = 13100;
ND_CLOCK_REVERSE_MODE_GR1 = 13120;
ND_CLOCK_REVERSE_MODE_GR2 = 13130;
ND_CONFIG_MEMORY_SIZE = 13150;
ND_CONTINUOUS = 13160;
ND_COUNT = 13200;
ND_COUNTER_0 = 13300;
ND_COUNTER_1 = 13400;
ND_COUNTER_2 = 13310;
ND_COUNTER_3 = 13320;
ND_COUNTER_4 = 13330;
ND_COUNTER_5 = 13340;
ND_COUNTER_6 = 13350;
ND_COUNTER_7 = 13360;
ND_COUNTER_1_SOURCE = 13430;
ND_COUNT_AVAILABLE = 13450;
ND_COUNT_DOWN = 13465;
ND_COUNT_UP = 13485;
ND_COUNT_1 = 13500;
ND_COUNT_2 = 13600;
ND_COUNT_3 = 13700;
ND_COUNT_4 = 13800;
ND_CURRENT_OUTPUT = 40200;
ND_DAC_RESOLUTION = 13950;
ND_DATA_TRANSFER_CONDITION = 13960;
ND_DATA_XFER_MODE_AI = 14000;
ND_DATA_XFER_MODE_AO_GR1 = 14100;
ND_DATA_XFER_MODE_AO_GR2 = 14200;
ND_DATA_XFER_MODE_DIO_GR1 = 14300;
ND_DATA_XFER_MODE_DIO_GR2 = 14400;
ND_DATA_XFER_MODE_DIO_GR3 = 14500;
ND_DATA_XFER_MODE_DIO_GR4 = 14600;
ND_DATA_XFER_MODE_DIO_GR5 = 14700;
ND_DATA_XFER_MODE_DIO_GR6 = 14800;
ND_DATA_XFER_MODE_DIO_GR7 = 14900;
ND_DATA_XFER_MODE_DIO_GR8 = 15000;
ND_DATA_XFER_MODE_GPCTR0 = 15100;
ND_DATA_XFER_MODE_GPCTR1 = 15200;
ND_DATA_XFER_MODE_GPCTR2 = 15110;
ND_DATA_XFER_MODE_GPCTR3 = 15120;
ND_DATA_XFER_MODE_GPCTR4 = 15130;
ND_DATA_XFER_MODE_GPCTR5 = 15140;
ND_DATA_XFER_MODE_GPCTR6 = 15150;
ND_DATA_XFER_MODE_GPCTR7 = 15160;
ND_DATA_XFER_MODE_GPCTR8 = 15165;
ND_DATA_XFER_MODE_GPCTR9 = 15170;
ND_DATA_XFER_MODE_GPCTR10 = 15175;
ND_DATA_XFER_MODE_GPCTR11 = 15180;
ND_DC = 15250;
ND_DDS_BUFFER_SIZE = 15255;
ND_DEVICE_NAME = 15260;
ND_DEVICE_POWER = 15270;
ND_DEVICE_SERIAL_NUMBER = 15280;
ND_DEVICE_STATE_DURING_SUSPEND_MODE = 15290;
ND_DEVICE_TYPE_CODE = 15300;
ND_DIGITAL_FILTER = 15350;
ND_DIGITAL_RESTART = 15375;
ND_DIO128_GET_PORT_THRESHOLD = 41200;
ND_DIO128_SELECT_INPUT_PORT = 41100;
ND_DIO128_SET_PORT_THRESHOLD = 41300;
ND_DISABLED = 15400;
ND_DISARM = 15450;
ND_DIVIDE_DOWN_SAMPLING_SUPPORTED = 15475;
ND_DMA_A_LEVEL = 15500;
ND_DMA_B_LEVEL = 15600;
ND_DMA_C_LEVEL = 15700;
ND_DONE = 15800;
ND_DONT_CARE = 15900;
ND_DONT_KNOW = 15950;
ND_EDGE_SENSITIVE = 16000;
ND_ENABLED = 16050;
ND_END = 16055;
ND_EXTERNAL = 16060;
ND_EXTERNAL_CALIBRATE = 16100;
ND_FACTORY_CALIBRATION_EQUIP = 16210;
ND_FACTORY_EEPROM_AREA = 16220;
ND_FIFO_EMPTY = 16230;
ND_FIFO_HALF_FULL_OR_LESS = 16240;
ND_FIFO_HALF_FULL_OR_LESS_UNTIL_FULL = 16245;
ND_FIFO_NOT_FULL = 16250;
ND_FIFO_TRANSFER_COUNT = 16260;
ND_FILTER_CORRECTION_FREQ = 16300;
ND_FOREGROUND = 16350;
ND_FREQ_OUT = 16400;
ND_FSK = 16500;
ND_EDGE_BASED_FSK = 16500;
ND_GATE = 17100;
ND_GATE_POLARITY = 17200;
ND_GPCTR0_GATE = 17300;
ND_GPCTR0_OUTPUT = 17400;
ND_GPCTR0_SOURCE = 17500;
ND_GPCTR1_GATE = 17600;
ND_GPCTR1_OUTPUT = 17700;
ND_GPCTR1_SOURCE = 17800;
ND_GPCTR2_GATE = 17320;
ND_GPCTR2_OUTPUT = 17420;
ND_GPCTR2_SOURCE = 17520;
ND_GPCTR3_GATE = 17330;
ND_GPCTR3_OUTPUT = 17430;
ND_GPCTR3_SOURCE = 17530;
ND_GPCTR4_GATE = 17340;
ND_GPCTR4_OUTPUT = 17440;
ND_GPCTR4_SOURCE = 17540;
ND_GPCTR5_GATE = 17350;
ND_GPCTR5_OUTPUT = 17450;
ND_GPCTR5_SOURCE = 17550;
ND_GPCTR6_GATE = 17360;
ND_GPCTR6_OUTPUT = 17460;
ND_GPCTR6_SOURCE = 17660;
ND_GPCTR7_GATE = 17370;
ND_GPCTR7_OUTPUT = 17470;
ND_GPCTR7_SOURCE = 17570;
ND_GROUND_DAC_REFERENCE = 17900;
ND_HARDWARE = 18000;
ND_HI_RES_SAMPLING = 18020;
ND_HIGH = 18050;
ND_HIGH_HYSTERESIS = 18080;
ND_HIGH_TO_LOW = 18100;
ND_HW_ANALOG_TRIGGER = 18900;
ND_IMPEDANCE = 19000;
ND_INACTIVE = 19010;
ND_INITIAL_COUNT = 19100;
ND_INIT_PLUGPLAY_DEVICES = 19110;
ND_INSIDE_REGION = 19150;
ND_INTERNAL = 19160;
ND_INTERNAL_100_KHZ = 19200;
ND_INTERNAL_10_MHZ = 19300;
ND_INTERNAL_1250_KHZ = 19320;
ND_INTERNAL_20_MHZ = 19400;
ND_INTERNAL_25_MHZ = 19410;
ND_INTERNAL_2500_KHZ = 19420;
ND_INTERNAL_5_MHZ = 19450;
ND_INTERNAL_7160_KHZ = 19460;
ND_INTERNAL_TIMER = 19500;
ND_INTERRUPTS = 19600;
ND_INTERRUPT_A_LEVEL = 19700;
ND_INTERRUPT_B_LEVEL = 19800;
ND_INTERRUPT_TRIGGER_MODE = 19850;
ND_IN_CHANNEL_CLOCK_TIMEBASE = 19900;
ND_IN_CHANNEL_CLOCK_TB_POL = 20000;
ND_IN_CONVERT = 20100;
ND_IN_CONVERT_POL = 20200;
ND_IN_DATA_FIFO_SIZE = 20250;
ND_IN_EXTERNAL_GATE = 20300;
ND_IN_EXTERNAL_GATE_POL = 20400;
ND_IN_SCAN_CLOCK_TIMEBASE = 20500;
ND_IN_SCAN_CLOCK_TB_POL = 20600;
ND_IN_SCAN_IN_PROG = 20650;
ND_IN_SCAN_START = 20700;
ND_IN_SCAN_START_POL = 20800;
ND_IN_START_TRIGGER = 20900;
ND_IN_START_TRIGGER_POL = 21000;
ND_IN_STOP_TRIGGER = 21100;
ND_IN_STOP_TRIGGER_POL = 21200;
ND_INT_AI_GND = 21210;
ND_INT_AO_CH_0 = 21230;
ND_INT_AO_CH_0_VS_REF_5V = 21235;
ND_INT_AO_CH_1 = 21240;
ND_INT_AO_CH_1_VS_AO_CH_0 = 21245;
ND_INT_AO_CH_1_VS_REF_5V = 21250;
ND_INT_AO_CH_2 = 21220;
ND_INT_AO_CH_3 = 21221;
ND_INT_AO_CH_4 = 21222;
ND_INT_AO_CH_5 = 21223;
ND_INT_AO_CH_6 = 21224;
ND_INT_AO_CH_7 = 21225;
ND_INT_AO_GND = 21260;
ND_INT_AO_GND_VS_AI_GND = 21265;
ND_INT_CM_REF_5V = 21270;
ND_INT_DEV_TEMP = 21280;
ND_INT_REF_5V = 21290;
ND_INT_REF_EXTERN = 21296;
ND_INT_CAL_BUS = 21295;
ND_INT_MUX_BUS = 21305;
ND_INT_AI_GND_AMP_0 = 21211;
ND_INT_AI_GND_AMP_1 = 21212;
ND_INT_AI_GND_AMP_2 = 21213;
ND_INT_AI_GND_AMP_3 = 21214;
ND_INT_AO_CH_0_AMP_0 = 21231;
ND_INT_AO_CH_0_AMP_1 = 21232;
ND_INT_AO_CH_0_AMP_2 = 21233;
ND_INT_AO_CH_0_AMP_3 = 21234;
ND_INT_AO_CH_1_AMP_0 = 21241;
ND_INT_AO_CH_1_AMP_1 = 21242;
ND_INT_AO_CH_1_AMP_2 = 21243;
ND_INT_AO_CH_1_AMP_3 = 21244;
ND_INT_AO_CH_0_VS_REF_AMP_0 = 21236;
ND_INT_AO_CH_0_VS_REF_AMP_1 = 21237;
ND_INT_AO_CH_0_VS_REF_AMP_2 = 21238;
ND_INT_AO_CH_0_VS_REF_AMP_3 = 21239;
ND_INT_AO_CH_1_VS_REF_AMP_0 = 21251;
ND_INT_AO_CH_1_VS_REF_AMP_1 = 21252;
ND_INT_AO_CH_1_VS_REF_AMP_2 = 21253;
ND_INT_AO_CH_1_VS_REF_AMP_3 = 21254;
ND_INT_AO_GND_VS_AI_GND_AMP_0 = 21266;
ND_INT_AO_GND_VS_AI_GND_AMP_1 = 21267;
ND_INT_AO_GND_VS_AI_GND_AMP_2 = 21268;
ND_INT_AO_GND_VS_AI_GND_AMP_3 = 21269;
ND_INT_CM_REF_AMP_0 = 21271;
ND_INT_CM_REF_AMP_1 = 21272;
ND_INT_CM_REF_AMP_2 = 21273;
ND_INT_CM_REF_AMP_3 = 21274;
ND_INT_REF_AMP_0 = 21291;
ND_INT_REF_AMP_1 = 21292;
ND_INT_REF_AMP_2 = 21293;
ND_INT_REF_AMP_3 = 21294;
ND_INTERRUPT_EVERY_SAMPLE = 11700;
ND_INTERRUPT_HALF_FIFO = 11800;
ND_IO_CONNECTOR = 21300;
ND_LEVEL_SENSITIVE = 24000;
ND_LINK_COMPLETE_INTERRUPTS = 24010;
ND_LOW = 24050;
ND_LOW_HYSTERESIS = 24080;
ND_LOW_TO_HIGH = 24100;
ND_LPT_DEVICE_MODE = 24200;
ND_MARKER = 24500;
ND_MARKER_QUANTUM = 24550;
ND_MAX_ARB_SEQUENCE_LENGTH = 24600;
ND_MAX_FUNC_SEQUENCE_LENGTH = 24610;
ND_MAX_LOOP_COUNT = 24620;
ND_MAX_NUM_WAVEFORMS = 24630;
ND_MAX_SAMPLE_RATE = 24640;
ND_MAX_WFM_SIZE = 24650;
ND_MEMORY_TRANSFER_WIDTH = 24700;
ND_MIN_SAMPLE_RATE = 24800;
ND_MIN_WFM_SIZE = 24810;
ND_NEGATIVE = 26100;
ND_NEW = 26190;
ND_NI_DAQ_SW_AREA = 26195;
ND_NO = 26200;
ND_NO_STRAIN_GAUGE = 26225;
ND_NO_TRACK_AND_HOLD = 26250;
ND_NONE = 26300;
ND_NOT_APPLICABLE = 26400;
ND_NUMBER_DIG_PORTS = 26500;
ND_OFF = 27010;
ND_OFFSET = 27020;
ND_ON = 27050;
ND_OTHER = 27060;
ND_OTHER_GPCTR_OUTPUT = 27300;
ND_OTHER_GPCTR_TC = 27400;
ND_OUT_DATA_FIFO_SIZE = 27070;
ND_OUT_EXTERNAL_GATE = 27080;
ND_OUT_EXTERNAL_GATE_POL = 27082;
ND_OUT_START_TRIGGER = 27100;
ND_OUT_START_TRIGGER_POL = 27102;
ND_OUT_UPDATE = 27200;
ND_OUT_UPDATE_POL = 27202;
ND_OUT_UPDATE_CLOCK_TIMEBASE = 27210;
ND_OUT_UPDATE_CLOCK_TB_POL = 27212;
ND_OUTPUT_ENABLE = 27220;
ND_OUTPUT_MODE = 27230;
ND_OUTPUT_POLARITY = 27240;
ND_OUTPUT_STATE = 27250;
ND_OUTPUT_TYPE = 40000;
ND_DIGITAL_PATTERN_GENERATION = 28030;
ND_PAUSE = 28040;
ND_PAUSE_ON_HIGH = 28045;
ND_PAUSE_ON_LOW = 28050;
ND_PFI_0 = 28100;
ND_PFI_1 = 28200;
ND_PFI_2 = 28300;
ND_PFI_3 = 28400;
ND_PFI_4 = 28500;
ND_PFI_5 = 28600;
ND_PFI_6 = 28700;
ND_PFI_7 = 28800;
ND_PFI_8 = 28900;
ND_PFI_9 = 29000;
ND_PFI_10 = 50280;
ND_PFI_11 = 50290;
ND_PFI_12 = 50300;
ND_PFI_13 = 50310;
ND_PFI_14 = 50320;
ND_PFI_15 = 50330;
ND_PFI_16 = 50340;
ND_PFI_17 = 50350;
ND_PFI_18 = 50360;
ND_PFI_19 = 50370;
ND_PFI_20 = 50380;
ND_PFI_21 = 50390;
ND_PFI_22 = 50400;
ND_PFI_23 = 50410;
ND_PFI_24 = 50420;
ND_PFI_25 = 50430;
ND_PFI_26 = 50440;
ND_PFI_27 = 50450;
ND_PFI_28 = 50460;
ND_PFI_29 = 50470;
ND_PFI_30 = 50480;
ND_PFI_31 = 50490;
ND_PFI_32 = 50500;
ND_PFI_33 = 50510;
ND_PFI_34 = 50520;
ND_PFI_35 = 50530;
ND_PFI_36 = 50540;
ND_PFI_37 = 50550;
ND_PFI_38 = 50560;
ND_PFI_39 = 50570;
ND_PLL_REF_FREQ = 29010;
ND_PLL_REF_SOURCE = 29020;
ND_PRE_ARM = 29050;
ND_POSITIVE = 29100;
ND_PREPARE = 29200;
ND_PROGRAM = 29300;
ND_PULSE = 29350;
ND_PULSE_SOURCE = 29500;
ND_PULSE_TRAIN_GNR = 29600;
ND_PXI_BACKPLANE_CLOCK = 29900;
ND_REGLITCH = 31000;
ND_RESERVED = 31100;
ND_RESET = 31200;
ND_RESUME = 31250;
ND_RETRIG_PULSE_GNR = 31300;
ND_REVISION = 31350;
ND_RTSI_0 = 31400;
ND_RTSI_1 = 31500;
ND_RTSI_2 = 31600;
ND_RTSI_3 = 31700;
ND_RTSI_4 = 31800;
ND_RTSI_5 = 31900;
ND_RTSI_6 = 32000;
ND_RTSI_CLOCK = 32100;
ND_SCANCLK = 32400;
ND_SCANCLK_LINE = 32420;
ND_SC_2040_MODE = 32500;
ND_SC_2043_MODE = 32600;
ND_SELF_CALIBRATE = 32700;
ND_SET_DEFAULT_LOAD_AREA = 32800;
ND_RESTORE_FACTORY_CALIBRATION = 32810;
ND_SET_POWERUP_STATE = 42100;
ND_SIMPLE_EVENT_CNT = 33100;
ND_SINGLE = 33150;
ND_SINGLE_PERIOD_MSR = 33200;
ND_SINGLE_PULSE_GNR = 33300;
ND_SINGLE_PULSE_WIDTH_MSR = 33400;
ND_SINGLE_TRIG_PULSE_GNR = 33500;
ND_SOURCE = 33700;
ND_SOURCE_POLARITY = 33800;
ND_STABLE_10_MHZ = 33810;
ND_STEPPED = 33825;
ND_STRAIN_GAUGE = 33850;
ND_STRAIN_GAUGE_EX0 = 33875;
ND_SUB_REVISION = 33900;
ND_SYNC_DUTY_CYCLE_HIGH = 33930;
ND_SYNC_OUT = 33970;
ND_TC_REACHED = 34100;
ND_THE_AI_CHANNEL = 34400;
ND_TOGGLE = 34700;
ND_TOGGLE_GATE = 34800;
ND_TRACK_AND_HOLD = 34850;
ND_TRIG_PULSE_WIDTH_MSR = 34900;
ND_TRIGGER_SOURCE = 34930;
ND_TRIGGER_MODE = 34970;
ND_UI2_TC = 35100;
ND_UP_DOWN = 35150;
ND_UP_TO_1_DMA_CHANNEL = 35200;
ND_UP_TO_2_DMA_CHANNELS = 35300;
ND_USE_CAL_CHAN = 36000;
ND_USE_AUX_CHAN = 36100;
ND_USER_EEPROM_AREA = 37000;
ND_USER_EEPROM_AREA_2 = 37010;
ND_USER_EEPROM_AREA_3 = 37020;
ND_USER_EEPROM_AREA_4 = 37030;
ND_USER_EEPROM_AREA_5 = 37040;
ND_DSA_RTSI_CLOCK_AD = 44000;
ND_DSA_RTSI_CLOCK_DA = 44010;
ND_DSA_OUTPUT_TRIGGER = 44020;
ND_DSA_INPUT_TRIGGER = 44030;
ND_DSA_SHARC_TRIGGER = 44040;
ND_DSA_ANALOG_TRIGGER = 44050;
ND_DSA_HOST_TRIGGER = 44060;
ND_DSA_EXTERNAL_DIGITAL_TRIGGER = 44070;
ND_VOLTAGE_OUTPUT = 40100;
ND_VOLTAGE_REFERENCE = 38000;
ND_VXI_SC = ($2000);
ND_PXI_SC = ($2010);
ND_VXIMIO_SET_ALLOCATE_MODE = 43100;
ND_VXIMIO_USE_ONBOARD_MEMORY_AI = 43500;
ND_VXIMIO_USE_ONBOARD_MEMORY_AO = 43600;
ND_VXIMIO_USE_ONBOARD_MEMORY_GPCTR = 43700;
ND_VXIMIO_USE_PC_MEMORY_AI = 43200;
ND_VXIMIO_USE_PC_MEMORY_AO = 43300;
ND_VXIMIO_USE_PC_MEMORY_GPCTR = 43400;
ND_WFM_QUANTUM = 45000;
ND_YES = 39100;
ND_3V_LEVEL = 43450;
ND_WRITE_MARK = 50000;
ND_READ_MARK = 50010;
ND_BUFFER_START = 50020;
ND_TRIGGER_POINT = 50025;
ND_BUFFER_MODE = 50030;
ND_DOUBLE = 50050;
ND_QUADRATURE_ENCODER_X1 = 50070;
ND_QUADRATURE_ENCODER_X2 = 50080;
ND_QUADRATURE_ENCODER_X4 = 50090;
ND_TWO_PULSE_COUNTING = 50100;
ND_LINE_FILTER = 50110;
ND_SYNCHRONIZATION = 50120;
ND_5_MICROSECONDS = 50130;
ND_1_MICROSECOND = 50140;
ND_500_NANOSECONDS = 50150;
ND_100_NANOSECONDS = 50160;
ND_1_MILLISECOND = 50170;
ND_10_MILLISECONDS = 50180;
ND_100_MILLISECONDS = 50190;
ND_OTHER_GPCTR_SOURCE = 50580;
ND_OTHER_GPCTR_GATE = 50590;
ND_AUX_LINE = 50600;
ND_AUX_LINE_POLARITY = 50610;
ND_TWO_SIGNAL_EDGE_SEPARATION_MSR = 50630;
ND_BUFFERED_TWO_SIGNAL_EDGE_SEPARATION_MSR = 50640;
ND_SWITCH_CYCLE = 50650;
ND_INTERNAL_MAX_TIMEBASE = 50660;
ND_PRESCALE_VALUE = 50670;
ND_MAX_PRESCALE = 50690;
ND_INTERNAL_LINE_0 = 50710;
ND_INTERNAL_LINE_1 = 50720;
ND_INTERNAL_LINE_2 = 50730;
ND_INTERNAL_LINE_3 = 50740;
ND_INTERNAL_LINE_4 = 50750;
ND_INTERNAL_LINE_5 = 50760;
ND_INTERNAL_LINE_6 = 50770;
ND_INTERNAL_LINE_7 = 50780;
ND_INTERNAL_LINE_8 = 50790;
ND_INTERNAL_LINE_9 = 50800;
ND_INTERNAL_LINE_10 = 50810;
ND_INTERNAL_LINE_11 = 50820;
ND_INTERNAL_LINE_12 = 50830;
ND_INTERNAL_LINE_13 = 50840;
ND_INTERNAL_LINE_14 = 50850;
ND_INTERNAL_LINE_15 = 50860;
ND_INTERNAL_LINE_16 = 50862;
ND_INTERNAL_LINE_17 = 50864;
ND_INTERNAL_LINE_18 = 50866;
ND_INTERNAL_LINE_19 = 50868;
ND_INTERNAL_LINE_20 = 50870;
ND_INTERNAL_LINE_21 = 50872;
ND_INTERNAL_LINE_22 = 50874;
ND_INTERNAL_LINE_23 = 50876;
ND_START_TRIGGER = 51150;
ND_START_TRIGGER_POLARITY = 51151;
ND_COUNTING_SYNCHRONOUS = 51200;
ND_SYNCHRONOUS = 51210;
ND_ASYNCHRONOUS = 51220;
ND_CONFIGURABLE_FILTER = 51230;
ND_ENCODER_TYPE = 51240;
ND_Z_INDEX_ACTIVE = 51250;
ND_Z_INDEX_VALUE = 51260;
ND_SNAPSHOT = 51270;
ND_POSITION_MSR = 51280;
ND_BUFFERED_POSITION_MSR = 51290;
ND_SAVED_COUNT = 51300;
ND_READ_MARK_H_SNAPSHOT = 51310;
ND_READ_MARK_L_SNAPSHOT = 51320;
ND_WRITE_MARK_H_SNAPSHOT = 51330;
ND_WRITE_MARK_L_SNAPSHOT = 51340;
ND_BACKLOG_H_SNAPSHOT = 51350;
ND_BACKLOG_L_SNAPSHOT = 51360;
ND_ARMED_SNAPSHOT = 51370;
ND_EDGE_GATED_FSK = 51371;
ND_SIMPLE_GATED_EVENT_CNT = 51372;
ND_VIDEO_TYPE = 51380;
ND_PAL_B = 51390;
ND_PAL_G = 51400;
ND_PAL_H = 51410;
ND_PAL_I = 51420;
ND_PAL_D = 51430;
ND_PAL_N = 51440;
ND_PAL_M = 51450;
ND_NTSC_M = 51460;
ND_COUNTER_TYPE = 51470;
ND_NI_TIO = 51480;
ND_AM9513 = 51490;
ND_STC = 51500;
ND_8253 = 51510;
ND_A_HIGH_B_HIGH = 51520;
ND_A_HIGH_B_LOW = 51530;
ND_A_LOW_B_HIGH = 51540;
ND_A_LOW_B_LOW = 51550;
ND_Z_INDEX_RELOAD_PHASE = 51560;
ND_UPDOWN_LINE = 51570;
ND_DEFAULT_PFI_LINE = 51580;
ND_BUFFER_SIZE = 51590;
ND_ELEMENT_SIZE = 51600;
ND_NUMBER_GP_COUNTERS = 51610;
ND_BUFFERED_TIME_STAMPING = 51620;
ND_TIME_0_DATA_32 = 51630;
ND_TIME_8_DATA_24 = 51640;
ND_TIME_16_DATA_16 = 51650;
ND_TIME_24_DATA_8 = 51660;
ND_TIME_32_DATA_32 = 51670;
ND_TIME_48_DATA_16 = 51680;
ND_ABSOLUTE = 51690;
ND_RELATIVE = 51700;
ND_TIME_DATA_SIZE = 51710;
ND_TIME_FORMAT = 51720;
ND_HALT_ON_OVERFLOW = 51730;
ND_OVERLAY_RTSI_ON_PFI_LINES = 51740;
ND_STOP_TRIGGER = 51750;
ND_TS_INPUT_MODE = 51760;
ND_BOTH_EDGES = 51770;
ND_CLOCK_0 = 51780;
ND_CLOCK_1 = 51790;
ND_CLOCK_2 = 51800;
ND_CLOCK_3 = 51810;
ND_SYNCHRONIZATION_LINE = 51820;
ND_TRANSFER_METHOD = 51830;
ND_SECONDS = 51840;
ND_PRECISION = 51850;
ND_NANO_SECONDS = 51860;
ND_SYNCHRONIZATION_METHOD = 51870;
ND_PULSE_PER_SECOND = 51880;
ND_IRIG_B = 51890;
ND_SIMPLE_TIME_MSR = 51900;
ND_SINGLE_TIME_MSR = 51910;
ND_BUFFERED_TIME_MSR = 51920;
ND_DMA = 51930;
implementation
end.
Raw
Region of Interest
unit DetectROIDlgu;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Spin, Buttons, ExtCtrls, Mpfileu;
type
TDetectROIDlg = class(TForm)
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
GroupBox1: TGroupBox;
Label1: TLabel;
SpinEdit1: TSpinEdit;
Label3: TLabel;
SpinEdit2: TSpinEdit;
CheckBox1: TCheckBox;
GroupBox2: TGroupBox;
RadioButton1: TRadioButton;
RadioButton3: TRadioButton;
RadioButton2: TRadioButton;
RadioButton4: TRadioButton;
GroupBox3: TGroupBox;
Label5: TLabel;
Label6: TLabel;
SpinEdit5: TSpinEdit;
SpinEdit6: TSpinEdit;
Label2: TLabel;
SpinEdit3: TSpinEdit;
Label4: TLabel;
SpinEdit4: TSpinEdit;
private
{ Private declarations }
public
{ Public declarations }
function SelectedCh: integer;
procedure SetGUI(aMPFile: TMPFile);
end;
var
DetectROIDlg: TDetectROIDlg;
implementation
{$R *.DFM}
function TDetectROIDlg.SelectedCh: integer;
begin
if RadioButton1.Checked then
Result := 0
else if RadioButton2.Checked then
Result :=1
else if RadioButton3.Checked then
Result := 2
else if RadioButton4.Checked then
Result := 3
else
Result := 0;
end;
procedure TDetectROIDlg.SetGUI(aMPFile: TMPFile);
begin
with aMPFile do
begin
RadioButton1.Checked := (DefaultVideoChannel = 0);
RadioButton2.Checked := (DefaultVideoChannel = 1);
RadioButton3.Checked := (DefaultVideoChannel = 2);
RadioButton4.Checked := (DefaultVideoChannel = 3);
if VideoChCount = 1 then
begin
RadioButton1.Enabled := False;
RadioButton2.Enabled := False;
RadioButton3.Enabled := False;
RadioButton4.Enabled := False;
end
else
begin
RadioButton1.Enabled := VideoChEnabled[0];
RadioButton2.Enabled := VideoChEnabled[1];
RadioButton3.Enabled := VideoChEnabled[2];
RadioButton4.Enabled := VideoChEnabled[3];
end;
end;
end;
end.
Raw
ROI
unit ROIu;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Menus, Trackcur, Horzbaru, ComCtrls, MPUnit, ROIThreadu, ExtCtrls;
type
TROIFrm = class(TForm)
MainMenu1: TMainMenu;
Axis1: TMenuItem;
XAxis1: TMenuItem;
YAxis1: TMenuItem;
Data1: TMenuItem;
Copydatatoclipboard1: TMenuItem;
StatusBar1: TStatusBar;
HorzTrackBar1: THorzTrackBar;
VertTrackBar1: TVertTrackBar;
N1: TMenuItem;
ResetCursorRelativeOrigins1: TMenuItem;
PopupMenu1: TPopupMenu;
ResetRelative1: TMenuItem;
N2: TMenuItem;
XAxisFullRange1: TMenuItem;
YAxisFullRange1: TMenuItem;
PreviousMagnification1: TMenuItem;
YAxisAutoscale1: TMenuItem;
procedure FormResize(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure XAxis1Click(Sender: TObject);
procedure YAxis1Click(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure ResetCursorRelativeOrigins1Click(Sender: TObject);
procedure HorzTrackBar1Change(Sender: TObject);
procedure Copydatatoclipboard1Click(Sender: TObject);
procedure XAxisFullRange1Click(Sender: TObject);
procedure SetXAxissize1Click(Sender: TObject);
procedure YAxisFullRange1Click(Sender: TObject);
procedure YAxisAutoscale1Click(Sender: TObject);
procedure PreviousMagnification1Click(Sender: TObject);
procedure VertTrackBar1Change(Sender: TObject);
private
{ Private declarations }
bInitialized, {prevents FormPaint before first FormResize}
bAdjustingCursorPos: boolean; {prevent activation of OnChange events}
fDataSize: integer;
fDisplayMode: TDisplayMode;
prev_xRight, prev_xWidth,
prev_yTop, prev_yHeight: integer;
{rectangle areas}
bitmapWidth, bitmapHeight: integer;
viewRect,
xAxisRect,
yAxisRect,
cornerRect: TRect;
xCursorPos,
yCursorPos,
refXCursorPos,
refYCursorPos: integer;
roiThread: TROIThread;
procedure AdjustCursorPos;
procedure AdjustLogicalCursorPos;
procedure DrawBitmap;
procedure DrawData;
procedure DrawXAxis;
procedure DrawXCursorOnBitmap;
procedure DrawXCursorOnScreen;
procedure DrawYAxis;
procedure DrawYCursorOnBitmap;
procedure DrawYCursorOnScreen;
procedure OnMagnificationChanged;
function RectBitmapToWindow(aRect: TRect): TRect;
function RectWindowToBitmap(aRect: TRect): TRect;
procedure ResizeElements;
procedure SetDataSize(newSize: integer);
procedure SetPrecision(newPrecision: TPrecision);
procedure UpdateCursorCaptions;
function XBitmapToData(xBitmap: integer): integer;
function XDataToBitmap(xData: integer): integer;
function YBitmapToData(yBitmap: integer): integer;
function YDataToBitmap(yData: integer): integer;
public
{ Public declarations }
f_MAX_Y_VALUE: integer;
{axis}
xRight, xWidth,
yTop, yHeight: integer; {logical values}
cXTickMarks, cYTickMarks: integer;
channel: integer;
ROIRect: TRect; {contains the absolute coordinates of the ROI rectangle}
ROIRegion: TRect; {the ROI in the frame buffer}
screenBitmapROIRect: TRect;
trace: TTrace;
ROIThreadMutex: THandle;
framesDisplayed: integer;
nextFrame: integer; {the index in dataBuffer for the next frame}
circdataBuffer: array of integer; {a circular buffer updated by the thread}
databuffer: array of integer; {used by TROIFrm to store data: non circular}
offscreenBitmap: TBitmap;
procedure CopyCircData; {copies circdataBuffer into dataBuffer - used by ROIThread}
procedure CopyOffscreenToScreen; {forces update of the screen}
procedure OnScanningStart; {resets the circular buffer}
procedure OnScanningEnd;
procedure RedrawOffscreen; {called by the thread}
procedure SavePrevMag;
property dataSize: integer read fDataSize write SetDataSize;
property displayMode: TDisplayMode write fDisplayMode;
property precision: TPrecision write SetPrecision;
end;
var
ROIFrm: TROIFrm;
implementation
{$R *.DFM}
uses ROIAxisDlgu, Mainfrm, Clipbrd;
const
TRACK_BAR_WIDTH = 17;
TRACK_BAR_HEIGHT = 17;
Y_AXIS_WIDTH = 75;
X_AXIS_HEIGHT = 35;
{**************************** PRIVATE METHODS *********************************}
procedure TROIFrm.AdjustCursorPos;
begin
bAdjustingCursorPos := True;
VertTrackBar1.Position := Muldiv(yCursorPos - (yTop - yHeight + 1),
bitmapHeight - 1, yHeight - 1);
HorzTrackBar1.Position := Muldiv(xCursorPos - (xRight + xWidth - 1), bitmapWidth - 1, - xWidth + 1);
bAdjustingCursorPos := False;
end;
procedure TROIFrm.AdjustLogicalCursorPos;
begin
xCursorPos := XBitmapToData(HorzTrackBar1.Position);
yCursorPos := YBitmapToData(VertTrackBar1.Position);
end;
procedure TROIFrm.DrawBitmap;
begin
with offscreenBitmap.Canvas do
begin
Brush.Color := clBlack;
FillRect(Rect(0, 0, bitmapWidth - 1, bitmapHeight - 1));
end;
end;
procedure TROIFrm.DrawData;
var lastIndex, firstIndex, i, j, k, indexofnextpt,
bufferlimit, dataVal, maxVal, minVal: integer;
bitmapY, bitmaprY: integer;
firstPPt: ^TPoint;
begin
if framesDisplayed > 0 then
begin
lastIndex := -1; firstIndex := -1;
if framesDisplayed < dataSize then
bufferlimit := nextFrame
else
bufferlimit := dataSize;
for i := bitmapWidth - 1 downto 0 do {index in trace}
begin
j := XBitmapToData(i); {index in data buffer}
indexofnextpt := XBitmapToData(i - 1) - 1;
if (j >= 0) and (j < bufferlimit) then
begin
if lastIndex = -1 then lastIndex := i;
firstIndex := i;
trace[i].MaxPt.y := dataBuffer[j];
trace[i].MinPt.y := trace[i].MaxPt.y;
if (indexofnextPt > j) and (indexofnextPt < bufferlimit) and
(j < bufferlimit - 1) then
for k := j + 1 to indexofnextPt do
begin
dataVal := dataBuffer[k];
if dataVal > trace[i].MaxPt.y then trace[i].MaxPt.y := dataVal;
if dataVal < trace[i].MinPt.y then trace[i].MinPt.y := dataVal;
end;
end; {j}
end; {i}
if (lastIndex <> -1) and (firstIndex <> -1) and (firstIndex < lastIndex) then
begin
if YAxisAutoscale1.Checked then
begin
{Autoscale}
maxVal := trace[firstIndex].MaxPt.y;
minVal := trace[firstIndex].MinPt.y;
{find the maximum and minimum values}
for i := firstIndex + 1 to lastIndex do
begin
if maxVal < trace[i].MaxPt.y then maxVal := trace[i].MaxPt.y;
if minVal < trace[i].MinPt.y then minVal := trace[i].MinPt.y;
end;
{at least 100 pixel difference for autoscale}
if maxVal >= minVal + 100 then
begin
bitmapY := YDataToBitmap(YCursorPos);
bitmaprY := YDataToBitmap(refYCursorPos);
yTop := (maxVal + minVal) div 2 + Muldiv(10, (maxVal - minVal + 1) div 2, 9);
yHeight := Muldiv(10, maxVal - minVal + 1, 9);
if yTop > f_MAX_Y_VALUE then yTop := f_MAX_Y_VALUE;
if yTop - yHeight < - f_MAX_Y_VALUE - 1 then
yHeight := f_MAX_Y_VALUE + 1 + yTop;
DrawYAxis;
YCursorPos := YBitmapToData(bitmapY);
refYCursorPos := YBitmapToData(bitmaprY);
UpdateCursorCaptions;
end;
end;
{logical to bitmap Y}
for i := firstIndex to lastIndex do
begin
dataVal := trace[i].MaxPt.y; trace[i].MaxPt.y := YDataToBitmap(dataVal);
dataVal := trace[i].MinPt.y; trace[i].MinPt.y := YDataToBitmap(dataVal);
end;
with offscreenbitmap.Canvas do
begin
Pen.Color := clWhite;
Pen.Mode := pmCopy;
Pen.Style := psSolid;
Pen.Width := 1;
end;
firstPPt := @trace[firstIndex].MaxPt;
Windows.Polyline(offscreenBitmap.Canvas.Handle, firstPPt,
2 * (lastIndex - firstIndex + 1));
end
end; {framesDisplayed > 0}
end;
procedure TROIFrm.DrawXAxis;
var i, x: integer;
s: string;
begin
Canvas.Brush.Color := clBtnFace;
Canvas.FillRect(xAxisRect);
with Canvas.Pen do
begin
Color := clBlue;
Width := 1;
Style := psSolid;
Mode := pmCopy;
end;
for i := 0 to cXTickMarks - 1 do
begin
x := viewRect.Left + MulDiv(i, bitmapWidth - 1, cXTickMarks - 1);
Canvas.MoveTo(x, xAxisRect.Top);
Canvas.LineTo(x, xAxisRect.Top + 10);
end;
s := Format('%.2g', [xWidth / (cXTickMarks - 1)]) + ' frames / division';
Canvas.Textout(ClientWidth div 2 - Canvas.TextWidth(s) div 2, xAxisRect.Bottom - 20, s);
end;
procedure TROIFrm.DrawXCursorOnBitmap;
var bitmapXCursor: integer;
begin
bitmapXCursor := XDataToBitmap(xCursorPos);
with offscreenbitmap.Canvas do
begin
Pen.Color := clYellow;
Pen.Mode := pmXor;
Pen.Style := psDot;
end;
Canvas.MoveTo(bitmapXCursor, 0);
Canvas.LineTo(bitmapXCursor, bitmapHeight - 1);
end;
procedure TROIFrm.DrawXCursorOnScreen;
var bitmapXCursor: integer;
rc: TRect;
begin
bitmapXCursor := XDataToBitmap(xCursorPos);
rc := Rect(bitmapXCursor - 1, 0, bitmapXCursor + 1, bitmapHeight - 1);
Canvas.CopyRect(rc, offscreenBitmap.Canvas, RectBitmapToWindow(rc));
end;
procedure TROIFrm.DrawYAxis;
var i, y, tw, th: integer;
s: string;
begin
Canvas.Brush.Color := clBtnFace;
Canvas.FillRect(yAxisRect);
with Canvas.Pen do
begin
Color := clBlue;
Width := 1;
Style := psSolid;
Mode := pmCopy;
end;
for i := 0 to cYTickMarks - 1 do
begin
y := viewRect.Top + MulDiv(i, bitmapHeight - 1, cYTickMarks - 1);
Canvas.MoveTo(yAxisRect.Right - 10, y);
Canvas.LineTo(yAxisRect.Right, y);
s := IntToStr(yTop - Muldiv(i, yHeight - 1, cYTickMarks - 1));
tw := Canvas.TextWidth(s);
th := Canvas.TextHeight(s);
Canvas.TextOut(yAxisRect.Right - tw - 15, y - th div 2, s);
end;
end;
procedure TROIFrm.DrawYCursorOnBitmap;
var bitmapYCursor: integer;
begin
bitmapYCursor := YDataToBitmap(yCursorPos);
with offscreenbitmap.Canvas do
begin
Pen.Color := clYellow;
Pen.Mode := pmXor;
Pen.Style := psDot;
end;
Canvas.MoveTo(0, bitmapYCursor);
Canvas.LineTo(bitmapWidth - 1, bitmapYCursor);
end;
procedure TROIFrm.DrawYCursorOnScreen;
var bitmapYCursor: integer;
rc: TRect;
begin
bitmapYCursor := YDataToBitmap(yCursorPos);
rc := Rect(0, bitmapYCursor - 1, bitmapWidth - 1, bitmapYCursor + 1);
Canvas.CopyRect(rc, offscreenBitmap.Canvas, RectBitmapToWindow(rc));
end;
procedure TROIFrm.OnMagnificationChanged;
begin
RedrawOffScreen;
AdjustLogicalCursorPos;
Invalidate;
UpdateCursorCaptions;
end;
function TROIFrm.RectBitmapToWindow(aRect: TRect): TRect;
begin
OffsetRect(aRect, viewRect.Left, viewRect.Top);
Result := aRect;
end;
function TROIFrm.RectWindowToBitmap(aRect: TRect): TRect;
begin
OffsetRect(aRect, -viewRect.Left, -viewRect.Top);
Result := aRect;
end;
procedure TROIFrm.ResizeElements;
var i: integer;
begin
{rectangles}
cornerRect := Rect(ClientWidth - TRACK_BAR_WIDTH, 0, ClientWidth - 1, TRACK_BAR_HEIGHT - 1);
yAxisRect := Rect(0, 0, Y_AXIS_WIDTH - 1, ClientHeight - StatusBar1.Height - 1);
xAxisRect := Rect(Y_AXIS_WIDTH, ClientHeight - StatusBar1.Height - X_AXIS_HEIGHT - 1, ClientWidth,
ClientHeight - StatusBar1.Height - 1);
viewRect := Rect(Y_AXIS_WIDTH, TRACK_BAR_HEIGHT, ClientWidth - TRACK_BAR_WIDTH - 1,
ClientHeight - X_AXIS_HEIGHT - StatusBar1.Height - 1);
{bitmap and trace}
offscreenBitmap.Width := viewRect.Right - viewRect.Left + 1;
offscreenBitmap.Height := viewRect.Bottom - viewRect.Top + 1;
bitmapWidth := viewRect.Right - viewRect.Left + 1;
bitmapHeight := viewRect.Bottom - viewRect.Top + 1;
SetLength(trace, bitmapWidth);
for i := 0 to bitmapWidth - 1 do
begin
trace[i].MaxPt.x := i;
trace[i].MinPt.x := i;
end;
{track bars}
HorzTrackBar1.SetBounds(0, Y_AXIS_WIDTH, ClientWidth - TRACK_BAR_WIDTH, TRACK_BAR_HEIGHT);
VertTrackBar1.SetBounds(ClientWidth - TRACK_BAR_WIDTH, TRACK_BAR_HEIGHT,
TRACK_BAR_WIDTH, ClientHeight - TRACK_BAR_HEIGHT - StatusBar1.Height);
HorzTrackBar1.Min := 0;
HorzTrackBar1.Max := bitmapWidth - 1;
VertTrackBar1.Min := 0;
VertTrackBar1.Max := bitmapHeight - 1;
RedrawOffscreen;
end;
procedure TROIFrm.SetDataSize(newSize: integer);
begin
fDataSize := newSize;
SetLength(circDataBuffer, fDataSize);
SetLength(dataBuffer, fDataSize);
framesDisplayed := 0;
nextFrame := 0;
end;
procedure TROIFrm.SetPrecision(newPrecision: TPrecision);
begin
case newPrecision of
PREC_8_BIT: f_MAX_Y_VALUE := 127;
PREC_10_BIT: f_MAX_Y_VALUE := 511;
PREC_12_BIT: f_MAX_Y_VALUE := 2047;
PREC_14_BIT: f_MAX_Y_VALUE := 8191;
else f_MAX_Y_VALUE := 32767;
end;
end;
procedure TROIFrm.UpdateCursorCaptions;
begin
StatusBar1.Panels[0].Text := 'X: ' + IntToStr(xCursorPos);
StatusBar1.Panels[1].Text := 'Y: ' + IntToStr(yCursorPos);
StatusBar1.Panels[2].Text := 'rX: ' + IntToStr(xCursorPos - refXCursorPos);
StatusBar1.Panels[3].Text := 'rY: ' + IntToStr(YCursorPos - refYCursorPos);
end;
function TROIFrm.XBitmapToData(xBitmap: integer): integer;
begin
if framesDisplayed > 0 then
Result := MulDiv(bitmapWidth - 1 - xBitmap, dataSize - 1, bitmapWidth - 1)
else
Result := -1;
end;
function TROIFrm.XDataToBitmap(xData: integer): integer;
begin
Result := bitmapWidth - 1 - Muldiv(xData, bitmapWidth - 1, dataSize - 1);
end;
function TROIFrm.YBitmapToData(yBitmap: integer): integer;
begin
Result := yTop - MulDiv(yBitmap, yHeight - 1, bitmapHeight - 1);
end;
function TROIFrm.YDataToBitmap(yData: integer): integer;
begin
Result := MulDiv(- yData + yTop, bitmapHeight - 1, yHeight - 1);
end;
{****************************** FORM EVENTS ***********************************}
procedure TROIFrm.FormCreate(Sender: TObject);
begin
f_MAX_Y_VALUE := 2047;
displayMode := DM_ANALYZING;
offscreenBitmap := TBitmap.Create;
offscreenBitmap.handleType := bmDDB;
dataSize := 1000; {default buffer size}
roiThreadMutex := CreateMutex(nil, False, nil);
xRight := 0;
xWidth := dataSize;
yTop := f_MAX_Y_VALUE;
yHeight := f_MAX_Y_VALUE * 2 + 1;
cXTickMarks := 5;
cYTickMarks := 5;
prev_xRight := xRight;
prev_xWidth := xWidth;
prev_yTop := yTop;
prev_yHeight := yHeight;
end;
procedure TROIFrm.FormResize(Sender: TObject);
begin
ResizeElements;
AdjustCursorPos;
bInitialized := True;
Invalidate;
end;
procedure TROIFrm.FormPaint(Sender: TObject);
var rc, interRect: TRect;
begin
if not bInitialized then Exit;
rc := Canvas.ClipRect;
Canvas.Brush.Color := clBtnFace;
Canvas.Pen.Color := clBlack;
Canvas.Pen.Mode := pmCopy;
Canvas.Pen.Style := psSolid;
if IntersectRect(interRect, rc, cornerRect) then
Canvas.FillRect(cornerRect);
if IntersectRect(interRect, rc, xAxisRect) then
DrawXAxis;
if IntersectRect(interRect, rc, yAxisRect) then
DrawYAxis;
if IntersectRect(interRect, rc, viewRect) then
Canvas.CopyRect(interRect, offscreenBitmap.Canvas, RectWindowToBitmap(interRect));
end;
procedure TROIFrm.FormDestroy(Sender: TObject);
begin
offscreenBitmap.Free;
if not Mainform.bClosing then
Mainform.ROIWndList.Remove(self);
CloseHandle(roiThreadMutex);
end;
{*********************************** MENUS ************************************}
procedure TROIFrm.XAxis1Click(Sender: TObject);
begin
ROIAxisDlg := TROIAxisDlg.Create(self);
try
ROIAxisDlg.ROIfrm := self;
ROIAxisDlg.PageControl1.ActivePageIndex := 0;
if ROIAxisDlg.ShowModal = mrOK then
OnMagnificationChanged;
finally
ROIAxisDlg.Free;
end;
end;
procedure TROIFrm.YAxis1Click(Sender: TObject);
begin
ROIAxisDlg := TROIAxisDlg.Create(self);
try
ROIAxisDlg.ROIfrm := self;
ROIAxisDlg.PageControl1.ActivePageIndex := 1;
if ROIAxisDlg.ShowModal = mrOK then
OnMagnificationChanged;
finally
ROIAxisDlg.Free;
end;
end;
procedure TROIFrm.YAxisAutoscale1Click(Sender: TObject);
begin
YAxisAutoscale1.Checked := not YAxisAutoscale1.Checked;
end;
procedure TROIFrm.XAxisFullRange1Click(Sender: TObject);
begin
xRight := 0;
xWidth := dataSize;
OnMagnificationChanged;
end;
procedure TROIFrm.YAxisFullRange1Click(Sender: TObject);
begin
yTop := f_MAX_Y_VALUE;
yHeight := 2 * f_MAX_Y_VALUE + 1;
OnMagnificationChanged;
end;
procedure TROIFrm.PreviousMagnification1Click(Sender: TObject);
begin
xRight := prev_xRight;
xWidth := prev_xWidth;
yTop := prev_yTop;
yHeight := prev_yHeight;
OnMagnificationChanged;
end;
procedure TROIFrm.SetXAxissize1Click(Sender: TObject);
var s: string;
newSize: integer;
begin
s := IntToStr(dataSize);
if InputQuery('Set trace size', 'Enter trace size',s) then
try
newSize := StrToInt(s);
if (newSize < 100) or (newSize > 10000) then
MessageDlg('Trace size must be between 100 and 10000', mtError, [mbOK], 0)
else
dataSize := newSize;
except
MessageDlg('Invalid numeric value', mtError, [mbOK], 0);
end;
end;
procedure TROIFrm.ResetCursorRelativeOrigins1Click(Sender: TObject);
begin
refXCursorPos := xCursorPos;
refYCursorPos := yCursorPos;
UpdateCursorCaptions;
end;
procedure TROIFrm.Copydatatoclipboard1Click(Sender: TObject);
type TCharArray = array[1..Maxint div 2] of Char;
var i, cPts: integer;
memhandle: THandle;
pString: ^TCharArray;
s1Length, stringindex: integer;
s1: string;
begin
if framesDisplayed > 0 then
try
Clipboard.Open;
Clipboard.Clear;
{fills string with data; 11 digits for each column}
if framesDisplayed < dataSize then
cPts := nextFrame
else
cPts := dataSize;
memHandle := GlobalAlloc(GMEM_MOVEABLE or GMEM_DDESHARE or GMEM_ZEROINIT, 24 *
cPts + 1);
pString := GlobalLock(memHandle);
stringindex := 0;
for i := 0 to cPts - 1 do
begin
s1 := IntToStr(i) + TAB;
s1Length := Length(s1);
CopyMemory(@(pString^[stringIndex]), @s1[1], s1Length);
stringIndex := stringIndex + s1Length; {points to the next character}
s1 := IntToStr(dataBuffer[i]) + CR;
s1Length := Length(s1);
CopyMemory(@(pString^[stringIndex]), @s1[1], s1Length);
stringIndex := stringIndex + s1Length; {points to the next character}
end;
Clipboard.SetAsHandle(CF_TEXT, memHandle);
finally
Clipboard.Close;
end;
end;
{****************************** PUBLIC METHODS *********************************}
procedure TROIFrm.CopyCircData; {copies circdataBuffer into dataBuffer}
var i: integer;
begin
if framesDisplayed > 0 then
begin
if (framesDisplayed < dataSize) then
begin
if nextFrame > 0 then
for i := 0 to nextFrame - 1 do dataBuffer[i] := circdataBuffer[i];
end
else
begin
{uncircularize data}
for i := nextFrame to dataSize - 1 do
dataBuffer[i - nextFrame] := circdataBuffer[i];
if nextFrame > 0 then
for i := 0 to nextFrame - 1 do
dataBuffer[i + dataSize - nextFrame] := circdataBuffer[i];
end;
end;
end;
procedure TROIFrm.CopyOffscreenToScreen; {forces update of the screen}
begin
Canvas.CopyRect(viewRect, offscreenBitmap.Canvas, Rect(0, 0, bitmapWidth - 1, bitmapHeight - 1));
end;
procedure TROIFrm.OnScanningStart; {resets the circular buffer}
begin
SetXAxissize1.Enabled := False;
Copydatatoclipboard1.Enabled := False;
framesDisplayed := 0;
nextFrame := 0;
roiThread := TROIThread.Create(True); {thread does not start immediatly}
roiThread.FreeOnTerminate := True;
roiThread.roiFrm := self;
roiThread.Resume;
end;
procedure TROIFrm.OnScanningEnd;
begin
SetXAxissize1.Enabled := True;
Copydatatoclipboard1.Enabled := True;
end;
procedure TROIFrm.RedrawOffscreen; {called by the thread}
begin
{Drawing}
DrawBitmap;
{Data}
DrawData;
{Cursors}
DrawXCursorOnBitmap;
DrawYCursorOnBitmap;
end;
procedure TROIFrm.SavePrevMag;
begin
prev_xRight := xRight;
prev_xWidth := xWidth;
prev_yTop := yTop;
prev_yHeight := yHeight;
end;
{*********************************** EVENTS ***********************************}
procedure TROIFrm.HorzTrackBar1Change(Sender: TObject);
begin
if not bAdjustingCursorPos then
begin
{draw}
DrawYCursorOnBitmap; {erases prev cursor}
DrawYCursorOnScreen; {gone!}
yCursorPos := YBitmapToData(HorzTrackBar1.Position);
DrawYCursorOnBitmap;
DrawYCursorOnScreen;
UpdateCursorCaptions;
end;
end;
procedure TROIFrm.VertTrackBar1Change(Sender: TObject);
begin
if not bAdjustingCursorPos then
begin
{draw}
DrawXCursorOnBitmap; {erases prev cursor}
DrawXCursorOnScreen; {gone!}
xCursorPos := xBitmapToData(HorzTrackBar1.Position);
DrawXCursorOnBitmap;
DrawXCursorOnScreen;
UpdateCursorCaptions;
end;
end;
end.
Raw
ROI Axis
unit ROIAxisDlgu;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, Spin, ComCtrls, Buttons, ROIFrmu;
type
TROIAxisDlg = class(TForm)
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
PageControl1: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
fromFrameEdit: TSpinEdit;
toFrameEdit: TSpinEdit;
cXTicksEdit: TSpinEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Bevel1: TBevel;
Label4: TLabel;
FromYEdit: TSpinEdit;
Label5: TLabel;
ToYEdit: TSpinEdit;
Bevel2: TBevel;
Label6: TLabel;
cYTicksEdit: TSpinEdit;
procedure FormShow(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
ROIfrm: TROIFrm;
end;
var
ROIAxisDlg: TROIAxisDlg;
implementation
{$R *.DFM}
procedure TROIAxisDlg.FormShow(Sender: TObject);
begin
with ROIfrm do
begin
{frames are 0-based}
fromFrameEdit.Value := xLeft;
toFrameEdit.Value := xLeft + xWidth - 1;
cXTicksEdit.Value := cXTickMarks;
FromYEdit.Value := yTop - yHeight + 1;
ToYEdit.Value := yTop;
cYTicksEdit.Value := cYTickMarks;
end;
end;
type
TAxisFrmError = (AFE_NO_ERROR, AFE_FROM_FRAME, AFE_TO_FRAME, AFE_XTICKS,
AFE_Y_FROM, AFE_Y_TO, AFE_YTICKS, AFE_X_ORDER, AFE_Y_ORDER);
resourcestring
sInvalidFromFrame = 'Invalid "From Frame" value.';
sInvalidToFrame = 'Invalid "To Frame" value.';
sInvalidXTicks = 'Invalid "Number of ticks" value for the X- axis.';
sInvalidYFrom = 'Invalid "From" value for the Y- axis.';
sInvalidYTo = 'Invalid "To" value for the Y- axis.';
sInvalidYTicks = 'Invalid "Number of ticks" value for the Y- axis.';
sInvalidXOrder = 'X-Axis "From Frame" value must be inferior than the "To Frame" value.';
sInvalidYOrder = 'Y-Axis "From" value must be inferior than the "To" value.';
procedure TROIAxisDlg.BitBtn1Click(Sender: TObject);
var AxisFrmError: TAxisFrmError;
begin
AxisFrmError := AFE_NO_ERROR;
with ROIfrm do
begin
if (fromFrameEdit.Value < 0) or (fromFrameEdit.Value >= dataSize) then
AxisFrmError := AFE_FROM_FRAME;
if (toFrameEdit.Value < 0) or (toFrameEdit.Value >= dataSize) then
AxisFrmError := AFE_TO_FRAME;
if fromFrameEdit.Value >= toFrameEdit.Value then
AxisFrmError := AFE_X_ORDER;
if (cXTicksEdit.Value < 0) or (cXTicksEdit.Value > 10) then
AxisFrmError := AFE_XTICKS;
if (FromYEdit.Value > f_MAX_Y_VALUE) or (FromYEdit.Value < - f_MAX_Y_VALUE - 1) then
AxisFrmError := AFE_Y_FROM;
if (ToYEdit.Value > f_MAX_Y_VALUE) or (ToYEdit.Value < - f_MAX_Y_VALUE - 1) then
AxisFrmError := AFE_Y_TO;
if FromYEdit.Value >= ToYEdit.Value then
AxisFrmError := AFE_Y_ORDER;
if (cYTicksEdit.Value < 0) or (cYTicksEdit.Value > 10) then
AxisFrmError := AFE_YTICKS;
end;
case AxisFrmError of
AFE_FROM_FRAME: MessageDlg(sInvalidFromFrame, mtError, [mbOK], 0);
AFE_TO_FRAME: MessageDlg(sInvalidToFrame, mtError, [mbOK], 0);
AFE_XTICKS: MessageDlg(sInvalidXTicks, mtError, [mbOK], 0);
AFE_Y_FROM: MessageDlg(sInvalidYFrom, mtError, [mbOK], 0);
AFE_Y_TO: MessageDlg(sInvalidYTo, mtError, [mbOK], 0);
AFE_YTICKS: MessageDlg(sInvalidYTicks, mtError, [mbOK], 0);
AFE_X_ORDER: MessageDlg(sInvalidXOrder, mtError, [mbOK], 0);
AFE_Y_ORDER: MessageDlg(sInvalidYOrder, mtError, [mbOK], 0);
end;
if AxisFrmError = AFE_NO_ERROR then
with ROIfrm do
begin
SavePrevMag;
xLeft := fromFrameEdit.Value;
xWidth := toFrameEdit.Value - xLeft + 1;
cXTickMarks := cXTicksEdit.Value;
yTop := ToYEdit.Value;
yHeight := yTop - FromYEdit.Value + 1;
cYTickMarks := cYTicksEdit.Value;
end
else
ModalResult := mrNone;
end;
end.
Raw
ROI frame
unit ROIFrmu;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Menus, Trackcur, Horzbaru, ComCtrls, MPViewu, MPFileu, ExtCtrls, Vieweru;
type
TROIFrm = class(TForm)
MainMenu1: TMainMenu;
Axis1: TMenuItem;
XAxis1: TMenuItem;
YAxis1: TMenuItem;
Data1: TMenuItem;
Copydatatoclipboard1: TMenuItem;
StatusBar1: TStatusBar;
N1: TMenuItem;
ResetCursorRelativeOrigins1: TMenuItem;
PopupMenu1: TPopupMenu;
ResetRelative1: TMenuItem;
N2: TMenuItem;
XAxisFullRange1: TMenuItem;
YAxisFullRange1: TMenuItem;
PreviousMagnification1: TMenuItem;
YAxisAutoscale1: TMenuItem;
CopydatatoclipboardasTEXT1: TMenuItem;
procedure FormResize(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure XAxis1Click(Sender: TObject);
procedure YAxis1Click(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure ResetCursorRelativeOrigins1Click(Sender: TObject);
procedure HorzTrackBar1Change(Sender: TObject);
procedure Copydatatoclipboard1Click(Sender: TObject);
procedure XAxisFullRange1Click(Sender: TObject);
procedure YAxisFullRange1Click(Sender: TObject);
procedure YAxisAutoscale1Click(Sender: TObject);
procedure PreviousMagnification1Click(Sender: TObject);
procedure VertTrackBar1Change(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormDestroy(Sender: TObject);
procedure CopydatatoclipboardasTEXT1Click(Sender: TObject);
private
{ Private declarations }
bInitialized, {prevents FormPaint before first FormResize}
bAdjustingCursorPos: boolean; {prevent activation of OnChange events}
fDataSize: integer;
prev_xLeft, prev_xWidth,
prev_yTop, prev_yHeight: integer;
{rectangle areas}
bitmapWidth, bitmapHeight: integer;
viewRect,
xAxisRect,
yAxisRect,
cornerRect: TRect;
xCursorPos,
yCursorPos,
refXCursorPos,
refYCursorPos: integer;
HorzTrackBar1: THorzTrackBar;
VertTrackBar1: TVertTrackBar;
procedure AdjustCursorPos;
procedure AdjustLogicalCursorPos;
procedure DrawBitmap;
procedure DrawData;
procedure DrawXCursorOnBitmap;
procedure DrawXCursorOnScreen;
procedure DrawAxis;
procedure DrawYCursorOnBitmap;
procedure DrawYCursorOnScreen;
procedure OnMagnificationChanged;
function RectBitmapToWindow(aRect: TRect): TRect;
function RectWindowToBitmap(aRect: TRect): TRect;
procedure RedrawOffScreen;
procedure ResizeElements;
procedure SetDataSize(newSize: integer);
procedure SetPrecision(newPrecision: TPrecision);
procedure UpdateCursorCaptions;
function XBitmapToData(xBitmap: integer): integer;
function XCursorDataToBitmap(xData: integer): integer;
function YBitmapToData(yBitmap: integer): integer;
function YDataToBitmap(yData: integer): integer;
public
{ Public declarations }
bLineProfile: boolean;
f_MAX_Y_VALUE: integer;
bDontUnregister: boolean;
{axis}
frameRate: double; {in seconds}
fromFrame, toFrame,
xLeft, xWidth,
yTop, yHeight: integer; {logical values}
cXTickMarks, cYTickMarks: integer;
dataBuffer: array of integer;
trace: TTrace;
offscreenBitmap: TBitmap;
procedure SavePrevMag;
procedure SaveDataToFile(bASCII: boolean; padding: integer; filename: string);
property dataSize: integer read fDataSize write SetDataSize;
property precision: TPrecision write SetPrecision;
end;
var
ROIFrm: TROIFrm;
implementation
{$R *.DFM}
uses ROIAxisDlgu, Clipbrd;
const
TRACK_BAR_WIDTH = 17;
TRACK_BAR_HEIGHT = 17;
Y_AXIS_WIDTH = 75;
X_AXIS_HEIGHT = 35;
{**************************** PRIVATE METHODS *********************************}
procedure TROIFrm.AdjustCursorPos;
begin
bAdjustingCursorPos := True;
VertTrackBar1.Position := {bitmapHeight - 1 -} Muldiv(yCursorPos - (yTop - yHeight + 1),
bitmapHeight - 1, yHeight - 1);
HorzTrackBar1.Position := Muldiv(xCursorPos - (xLeft + xWidth - 1), bitmapWidth - 1, - xWidth + 1);
bAdjustingCursorPos := False;
end;
procedure TROIFrm.AdjustLogicalCursorPos;
begin
xCursorPos := XBitmapToData(HorzTrackBar1.Position);
yCursorPos := YBitmapToData(bitmapHeight - 1 - VertTrackBar1.Position);
end;
procedure TROIFrm.DrawBitmap;
begin
with offscreenBitmap.Canvas do
begin
Brush.Color := clBlack;
FillRect(Rect(0, 0, bitmapWidth - 1, bitmapHeight - 1));
end;
end;
procedure TROIFrm.DrawData;
var lastIndex, firstIndex, i, j, k, indexofnextpt,
dataVal, maxVal, minVal: integer;
bitmapY, bitmaprY: integer;
begin
lastIndex := -1; firstIndex := -1;
for i := 0 to bitmapWidth - 1 do {index in trace}
begin
j := XBitmapToData(i); {index in data buffer}
indexofnextpt := XBitmapToData(i + 1) - 1;
if (j >= 0) and (j < datasize) then
begin
if firstIndex = -1 then firstIndex := i;
lastIndex := i;
trace[i].MaxPt.y := dataBuffer[j];
trace[i].MinPt.y := trace[i].MaxPt.y;
if (indexofnextPt > j) and (indexofnextPt < datasize) and
(j < datasize - 1) then
for k := j + 1 to indexofnextPt do
begin
dataVal := dataBuffer[k];
if dataVal > trace[i].MaxPt.y then trace[i].MaxPt.y := dataVal;
if dataVal < trace[i].MinPt.y then trace[i].MinPt.y := dataVal;
end;
end; {j}
end; {i}
if (lastIndex <> -1) and (firstIndex <> -1) and (firstIndex < lastIndex) then
begin
if YAxisAutoscale1.Checked then
begin
{Autoscale}
maxVal := trace[firstIndex].MaxPt.y;
minVal := trace[firstIndex].MinPt.y;
{find the maximum and minimum values}
for i := firstIndex + 1 to lastIndex do
begin
if maxVal < trace[i].MaxPt.y then maxVal := trace[i].MaxPt.y;
if minVal < trace[i].MinPt.y then minVal := trace[i].MinPt.y;
end;
{at least 100 pixel difference for autoscale}
if maxVal >= minVal + 100 then
begin
bitmapY := YDataToBitmap(YCursorPos);
bitmaprY := YDataToBitmap(refYCursorPos);
yTop := (maxVal + minVal) div 2 + Muldiv(10, (maxVal - minVal + 1) div 2, 9);
yHeight := Muldiv(10, maxVal - minVal + 1, 9);
if yTop > f_MAX_Y_VALUE then yTop := f_MAX_Y_VALUE;
if yTop - yHeight < - f_MAX_Y_VALUE - 1 then
yHeight := f_MAX_Y_VALUE + 1 + yTop;
DrawAxis;
YCursorPos := YBitmapToData(bitmapY);
refYCursorPos := YBitmapToData(bitmaprY);
UpdateCursorCaptions;
end;
end;
{logical to bitmap Y}
for i := firstIndex to lastIndex do
begin
dataVal := YDataToBitmap(trace[i].MaxPt.y);
if dataVal < 0 then dataVal := 0; if dataVal >= bitmapHeight then dataVal := bitmapHeight - 1;
trace[i].MaxPt.y := dataVal;
dataVal := YDataToBitmap(trace[i].MinPt.y);
if dataVal < 0 then dataVal := 0; if dataVal >= bitmapHeight then dataVal := bitmapHeight - 1;
trace[i].MinPt.y := dataVal;
end;
with offscreenbitmap.Canvas do
begin
Pen.Color := clWhite;
Pen.Mode := pmCopy;
Pen.Style := psSolid;
Pen.Width := 1;
end;
Windows.Polyline(offscreenBitmap.Canvas.Handle, trace[firstIndex].MaxPt,
2 * (lastIndex - firstIndex + 1));
end;
end;
procedure TROIFrm.DrawAxis;
var i, x: integer;
{ timebase: double;} {in s}
y, tw, th: integer;
s: string;
begin
Canvas.Brush.Color := clBtnFace;
Canvas.FillRect(xAxisRect);
Canvas.FillRect(yAxisRect);
with Canvas.Pen do
begin
Color := clBlue;
Width := 1;
Style := psSolid;
Mode := pmCopy;
end;
for i := 0 to cXTickMarks - 1 do
begin
x := viewRect.Left + MulDiv(i, bitmapWidth - 1, cXTickMarks - 1);
if i > 1 then x := x - 1; {adjusting for pen width}
Canvas.MoveTo(x, xAxisRect.Top);
Canvas.LineTo(x, xAxisRect.Top + 10);
end;
if not bLineProfile then
{ timebase := xWidth / (cXTickMarks - 1) / Mainform.configuration.frameRate;}
s := Format('%.2f', [xWidth / (cXTickMarks - 1)]) + ' frames / division'
{ + Format('%.2f', [timebase]) + ' s' }
else
s := 'Pixels';
Canvas.Textout(xAxisRect.Left + (xAxisRect.Right - xAxisRect.Left) div 2
- Canvas.TextWidth(s) div 2, xAxisRect.Bottom - 20, s);
for i := 0 to cYTickMarks - 1 do
begin
y := viewRect.Top + MulDiv(i, bitmapHeight - 1, cYTickMarks - 1);
Canvas.MoveTo(yAxisRect.Right - 10, y);
Canvas.LineTo(yAxisRect.Right, y);
s := IntToStr(yTop - Muldiv(i, yHeight - 1, cYTickMarks - 1));
tw := Canvas.TextWidth(s);
th := Canvas.TextHeight(s);
Canvas.TextOut(yAxisRect.Right - tw - 15, y - th div 2, s);
end;
end;
procedure TROIFrm.DrawXCursorOnBitmap;
var bitmapXCursor: integer;
begin
bitmapXCursor := XCursorDataToBitmap(xCursorPos);
with offscreenbitmap.Canvas do
begin
Pen.Color := clYellow;
Pen.Mode := pmXor;
Pen.Style := psDot;
Pen.Width := 1;
MoveTo(bitmapXCursor, 0);
LineTo(bitmapXCursor, bitmapHeight - 1);
end;
end;
procedure TROIFrm.DrawXCursorOnScreen;
var bitmapXCursor: integer;
rc: TRect;
begin
bitmapXCursor := XCursorDataToBitmap(xCursorPos);
rc := Rect(bitmapXCursor - 1, 0, bitmapXCursor + 1, bitmapHeight - 1);
Canvas.CopyRect(RectBitmapToWindow(rc), offscreenBitmap.Canvas, rc);
end;
procedure TROIFrm.DrawYCursorOnBitmap;
var bitmapYCursor: integer;
begin
bitmapYCursor := YDataToBitmap(yCursorPos);
with offscreenbitmap.Canvas do
begin
Pen.Color := clYellow;
Pen.Mode := pmXor;
Pen.Style := psDot;
Pen.Width := 1;
MoveTo(0, bitmapYCursor);
LineTo(bitmapWidth - 1, bitmapYCursor);
end;
end;
procedure TROIFrm.DrawYCursorOnScreen;
var bitmapYCursor: integer;
rc: TRect;
begin
bitmapYCursor := YDataToBitmap(yCursorPos);
rc := Rect(0, bitmapYCursor - 1, bitmapWidth - 1, bitmapYCursor + 1);
Canvas.CopyRect(RectBitmapToWindow(rc), offscreenBitmap.Canvas, rc);
end;
procedure TROIFrm.OnMagnificationChanged;
begin
RedrawOffScreen;
AdjustLogicalCursorPos;
Invalidate;
UpdateCursorCaptions;
end;
function TROIFrm.RectBitmapToWindow(aRect: TRect): TRect;
begin
OffsetRect(aRect, viewRect.Left, viewRect.Top);
Result := aRect;
end;
function TROIFrm.RectWindowToBitmap(aRect: TRect): TRect;
begin
OffsetRect(aRect, -viewRect.Left, -viewRect.Top);
Result := aRect;
end;
procedure TROIFrm.RedrawOffScreen;
begin
DrawBitmap;
DrawData;
DrawXCursorOnBitmap;
DrawYCursorOnBitmap;
end;
procedure TROIFrm.ResizeElements;
var i: integer;
begin
{rectangles}
cornerRect := Rect(ClientWidth - TRACK_BAR_WIDTH, 0, ClientWidth - 1, TRACK_BAR_HEIGHT - 1);
yAxisRect := Rect(0, 0, Y_AXIS_WIDTH - 1, ClientHeight - StatusBar1.Height - 1);
xAxisRect := Rect(Y_AXIS_WIDTH, ClientHeight - StatusBar1.Height - X_AXIS_HEIGHT - 1, ClientWidth,
ClientHeight - StatusBar1.Height - 1);
viewRect := Rect(Y_AXIS_WIDTH + 1, TRACK_BAR_HEIGHT + 1, ClientWidth - TRACK_BAR_WIDTH,
ClientHeight - X_AXIS_HEIGHT - StatusBar1.Height);
bitmapWidth := viewRect.Right - viewRect.Left + 1;
bitmapHeight := viewRect.Bottom - viewRect.Top + 1;
offscreenBitmap.Width := bitmapWidth;
offscreenBitmap.Height := bitmapHeight;
SetLength(trace, bitmapWidth);
for i := 0 to bitmapWidth - 1 do
begin
trace[i].MaxPt.x := i;
trace[i].MinPt.x := i;
end;
HorzTrackBar1.Min := 0;
HorzTrackBar1.Max := bitmapWidth - 1;
VertTrackBar1.Min := 0;
VertTrackBar1.Max := bitmapHeight - 1;
HorzTrackBar1.SetBounds(Y_AXIS_WIDTH, 0, ClientWidth - TRACK_BAR_WIDTH - Y_AXIS_WIDTH, TRACK_BAR_HEIGHT);
VertTrackBar1.SetBounds(ClientWidth - TRACK_BAR_WIDTH, TRACK_BAR_HEIGHT,
TRACK_BAR_WIDTH, ClientHeight - TRACK_BAR_HEIGHT - StatusBar1.Height - X_AXIS_HEIGHT);
UpdateCursorCaptions;
RedrawOffscreen;
end;
procedure TROIFrm.SetDataSize(newSize: integer);
begin
fDataSize := newSize;
SetLength(dataBuffer, fDataSize);
xLeft := 0;
xWidth := newSize;
end;
procedure TROIFrm.SetPrecision(newPrecision: TPrecision);
begin
case newPrecision of
PREC_8_BIT: f_MAX_Y_VALUE := 127;
PREC_10_BIT: f_MAX_Y_VALUE := 511;
PREC_12_BIT: f_MAX_Y_VALUE := 2047;
PREC_14_BIT: f_MAX_Y_VALUE := 8191;
else f_MAX_Y_VALUE := 32767;
end;
end;
procedure TROIFrm.UpdateCursorCaptions;
begin
StatusBar1.Panels[0].Text := 'X: ' + IntToStr(xCursorPos);
StatusBar1.Panels[1].Text := 'Y: ' + IntToStr(yCursorPos);
StatusBar1.Panels[2].Text := 'rX: ' + IntToStr(xCursorPos - refXCursorPos);
StatusBar1.Panels[3].Text := 'rY: ' + IntToStr(YCursorPos - refYCursorPos);
end;
function TROIFrm.XBitmapToData(xBitmap: integer): integer;
begin
Result := MulDiv(xBitmap, xWidth - 1, bitmapWidth - 1);
end;
function TROIFrm.XCursorDataToBitmap(xData: integer): integer;
begin
Result := Muldiv(xData - xLeft, bitmapWidth - 1, xWidth - 1);
end;
function TROIFrm.YBitmapToData(yBitmap: integer): integer;
begin
Result := yTop - MulDiv(yBitmap, yHeight - 1, bitmapHeight - 1);
end;
function TROIFrm.YDataToBitmap(yData: integer): integer;
begin
Result := MulDiv(- yData + yTop, bitmapHeight - 1, yHeight - 1);
end;
{****************************** FORM EVENTS ***********************************}
procedure TROIFrm.FormCreate(Sender: TObject);
begin
HorzTrackBar1 := THorzTrackBar.Create(self);
HorzTrackBar1.Parent := self;
HorzTrackBar1.OnChange := HorzTrackBar1Change;
VertTrackBar1 := TVertTrackBar.Create(self);
VertTrackBar1.Parent := self;
VertTrackBar1.OnChange := VertTrackBar1Change;
f_MAX_Y_VALUE := 2047;
offscreenBitmap := TBitmap.Create;
offscreenBitmap.handleType := bmDDB;
xLeft := 0;
xWidth := dataSize;
yTop := f_MAX_Y_VALUE;
yHeight := f_MAX_Y_VALUE * 2 + 1;
cXTickMarks := 5;
cYTickMarks := 5;
prev_xLeft := xLeft;
prev_xWidth := xWidth;
prev_yTop := yTop;
prev_yHeight := yHeight;
end;
procedure TROIFrm.FormResize(Sender: TObject);
begin
ResizeElements;
AdjustCursorPos;
bInitialized := True;
Invalidate;
end;
procedure TROIFrm.FormPaint(Sender: TObject);
var rc, interRect: TRect;
begin
if not bInitialized then Exit;
rc := Canvas.ClipRect;
Canvas.Brush.Color := clBtnFace;
Canvas.Pen.Color := clBlack;
Canvas.Pen.Mode := pmCopy;
Canvas.Pen.Style := psSolid;
if IntersectRect(interRect, rc, cornerRect) then
Canvas.FillRect(cornerRect);
if IntersectRect(interRect, rc, xAxisRect) or IntersectRect(interRect, rc, yAxisRect) then
DrawAxis;
if IntersectRect(interRect, rc, viewRect) then
begin
RedrawOffscreen;
Canvas.CopyRect(interRect, offscreenBitmap.Canvas, RectWindowToBitmap(interRect));
end;
end;
{*********************************** MENUS ************************************}
procedure TROIFrm.XAxis1Click(Sender: TObject);
begin
ROIAxisDlg := TROIAxisDlg.Create(self);
try
ROIAxisDlg.ROIfrm := self;
ROIAxisDlg.PageControl1.ActivePageIndex := 0;
if ROIAxisDlg.ShowModal = mrOK then
OnMagnificationChanged;
finally
ROIAxisDlg.Free;
end;
end;
procedure TROIFrm.YAxis1Click(Sender: TObject);
begin
ROIAxisDlg := TROIAxisDlg.Create(self);
try
ROIAxisDlg.ROIfrm := self;
ROIAxisDlg.PageControl1.ActivePageIndex := 1;
if ROIAxisDlg.ShowModal = mrOK then
OnMagnificationChanged;
finally
ROIAxisDlg.Free;
end;
end;
procedure TROIFrm.YAxisAutoscale1Click(Sender: TObject);
begin
YAxisAutoscale1.Checked := not YAxisAutoscale1.Checked;
end;
procedure TROIFrm.XAxisFullRange1Click(Sender: TObject);
begin
xLeft := 0;
xWidth := dataSize;
OnMagnificationChanged;
end;
procedure TROIFrm.YAxisFullRange1Click(Sender: TObject);
begin
yTop := f_MAX_Y_VALUE;
yHeight := 2 * (f_MAX_Y_VALUE + 1);
OnMagnificationChanged;
end;
procedure TROIFrm.PreviousMagnification1Click(Sender: TObject);
begin
xLeft := prev_xLeft;
xWidth := prev_xWidth;
yTop := prev_yTop;
yHeight := prev_yHeight;
OnMagnificationChanged;
end;
procedure TROIFrm.ResetCursorRelativeOrigins1Click(Sender: TObject);
begin
refXCursorPos := xCursorPos;
refYCursorPos := yCursorPos;
UpdateCursorCaptions;
end;
procedure TROIFrm.Copydatatoclipboard1Click(Sender: TObject);
type TCharArray = array[0..Maxint div 2] of Char;
var i: integer;
memhandle: THandle;
pString: ^TCharArray;
swLength, stringindex: integer;
s1: string;
sw: array[0..79] of WideChar;
begin
try
Clipboard.Open;
Clipboard.Clear;
{fills string with data; 11 digits for each column - each digit is a wide char}
memHandle := GlobalAlloc(GMEM_MOVEABLE or GMEM_DDESHARE or GMEM_ZEROINIT,
SizeOf(WideChar) * 25 {2 columns of 11 digits + TAB + CRLF} * dataSize + 1);
pString := GlobalLock(memHandle);
stringindex := 0;
for i := 0 to dataSize - 1 do
begin
s1 := Format('%.6f', [(fromFrame + i)/FrameRate]) + TAB;
swLength := 2 * Length(s1);
CopyMemory(@(pString^[stringIndex]), StringToWideChar(s1, @sw, 80), swLength);
stringIndex := stringIndex + swLength; {points to the next character}
s1 := IntToStr(dataBuffer[i]) + CRLF;
swLength := 2 * Length(s1);
CopyMemory(@(pString^[stringIndex]), StringToWideChar(s1, @sw, 80), swLength);
stringIndex := stringIndex + swLength; {points to the next character}
end;
Clipboard.SetAsHandle(CF_UNICODETEXT, memHandle);
finally
Clipboard.Close;
end;
end;
{****************************** PUBLIC METHODS *********************************}
procedure TROIFrm.SavePrevMag;
begin
prev_xLeft := xLeft;
prev_xWidth := xWidth;
prev_yTop := yTop;
prev_yHeight := yHeight;
end;
procedure TROIFrm.SaveDataToFile(bASCII: boolean; padding: integer; filename: string);
var i, paddingIndex: integer;
fileStream: TFileStream;
swLength: integer;
s1: string;
sw: array[0..179] of WideChar;
begin
fileStream := TFileStream.Create(filename, fmCreate or fmShareExclusive);
try
fileStream.Seek(0, soFromBeginning);
{fills string with data; 11 digits for each column - each digit is a wide char, 2 columns}
{number of rows is (toFrame - fromFrame + 1) * ChDataPtsPerFrame[]}
{frameIndex: 0 to toFrame - fromFrame}
{time in s for each frame: (fromFrame + frameIndex) * FrameSize * PixelClock * 1e-6 }
{sampleIndex: 0 to ChDataPtsPerFrame[] - 1}
{for each sample: sampleIndex * FrameSize * PixelClock * 1e-6 / ChDataPtsPerFrame[]}
for i := 0 to dataSize - 1 do
for paddingIndex := 0 to padding - 1 do
begin
s1 := Format('%.6f', [(fromFrame + i + paddingIndex/padding)/FrameRate]) + TAB + IntToStr(dataBuffer[i]) + CRLF;
if bASCII then
fileStream.Write(s1[1], Length(s1))
else
begin
swLength := 2 * Length(s1); {Unicode business}
StringToWideChar(s1, @sw, swLength + 1);
fileStream.Write(sw, swLength);
end;
end;
finally
fileStream.Free;
end;
end;
{*********************************** EVENTS ***********************************}
procedure TROIFrm.HorzTrackBar1Change(Sender: TObject);
begin
if not bAdjustingCursorPos then
begin
{draw}
DrawXCursorOnBitmap; {erases prev cursor}
DrawXCursorOnScreen; {gone!}
xCursorPos := xBitmapToData(HorzTrackBar1.Position);
DrawXCursorOnBitmap;
DrawXCursorOnScreen;
UpdateCursorCaptions;
end;
end;
procedure TROIFrm.VertTrackBar1Change(Sender: TObject);
begin
if not bAdjustingCursorPos then
begin
{draw}
DrawYCursorOnBitmap; {erases prev cursor}
DrawYCursorOnScreen; {gone!}
yCursorPos := yBitmapToData(vertTrackBar1.Max - vertTrackBar1.Position);
DrawYCursorOnBitmap;
DrawYCursorOnScreen;
UpdateCursorCaptions;
end;
end;
procedure TROIFrm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caFree;
end;
procedure TROIFrm.FormDestroy(Sender: TObject);
begin
offscreenBitmap.Free;
end;
procedure TROIFrm.CopydatatoclipboardasTEXT1Click(Sender: TObject);
type TCharArray = array[0..Maxint div 2] of Char;
var i: integer;
memhandle: THandle;
pString: ^TCharArray;
swLength, stringindex: integer;
s1: string;
begin
try
Clipboard.Open;
Clipboard.Clear;
{fills string with data; 11 digits for each column - each digit is a wide char}
memHandle := GlobalAlloc(GMEM_MOVEABLE or GMEM_DDESHARE or GMEM_ZEROINIT,
25 {2 columns of 11 digits + TAB + CRLF} * dataSize + 1);
pString := GlobalLock(memHandle);
stringindex := 0;
for i := 0 to dataSize - 1 do
begin
s1 := Format('%.6f', [(fromFrame + i)/FrameRate]) + TAB;
swLength := Length(s1);
CopyMemory(@(pString^[stringIndex]), @s1[1], swLength);
stringIndex := stringIndex + swLength; {points to the next character}
s1 := IntToStr(dataBuffer[i]) + CRLF;
swLength := Length(s1);
CopyMemory(@(pString^[stringIndex]), @s1[1], swLength);
stringIndex := stringIndex + swLength; {points to the next character}
end;
Clipboard.SetAsHandle(CF_TEXT, memHandle);
finally
Clipboard.Close;
end;
end;
end.
Raw
Statistics
unit StatDlgu;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, Mask, Buttons, MPFileu;
type
TStatDlg = class(TForm)
BitBtn1: TBitBtn;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
SpeedButton1: TSpeedButton;
Label7: TLabel;
Label9: TLabel;
Label10: TLabel;
MaskEdit1: TMaskEdit;
MaskEdit2: TMaskEdit;
MaskEdit3: TMaskEdit;
MaskEdit4: TMaskEdit;
Label11: TLabel;
Bevel1: TBevel;
Bevel2: TBevel;
Bevel3: TBevel;
Label12: TLabel;
Label13: TLabel;
Label14: TLabel;
Bevel4: TBevel;
Label15: TLabel;
Label16: TLabel;
Bevel5: TBevel;
Label17: TLabel;
procedure SpeedButton1Click(Sender: TObject);
private
{ Private declarations }
fMPFile: TMPFile;
fchIndex: integer;
fFrameIndex: integer;
procedure RefreshStats;
public
{ Public declarations }
procedure Initialize(ampFile: TMPFile; framenumber, channelnumber: integer;
areaRC: TRect);
end;
var
StatDlg: TStatDlg;
implementation
{$R *.DFM}
uses MPViewu;
procedure TStatDlg.RefreshStats;
var rc: TRect;
x, y, value: integer;
begin
try
rc.Left := StrToInt(MaskEdit1.Text);
rc.Top := StrToInt(MaskEdit2.Text);
rc.Right := StrToInt(MaskEdit3.Text);
rc.Bottom := StrToInt(MaskEdit4.Text);
if (rc.Left >= 0) and (rc.Left < fMPFile.FrameWidth) and (rc.Top >= 0) and
(rc.Top < fMPFile.FrameHeight) and (rc.Right >= 0) and (rc.Right < fMPFile.FrameWidth) and
(rc.Bottom >= 0) and (rc.Bottom < fMPFile.FrameHeight) then
begin
NormalizeRect(rc);
value := fMPFile.GetAverage(fFrameIndex, fChIndex, rc);
Label11.Caption := IntToStr(value);
value := fMPFile.GetMax(fFrameIndex, fChIndex, rc, x, y);
Label12.Caption := IntToStr(value);
Label13.Caption := 'X = ' + IntToStr(x) + ', Y = ' + IntToStr(y);
value := fMPFile.GetMin(fFrameIndex, fChIndex, rc, x, y);
Label15.Caption := IntToStr(value);
Label17.Caption := 'X = ' + IntToStr(x) + ', Y = ' + IntToStr(y);
end
else
MessageDlg('Area Parameters Out Of Bounds.', mtError, [mbOK], 0);
except
MessageDlg('Invalid Area Parameters.', mtError, [mbOK], 0);
end;
end;
procedure TStatDlg.Initialize(ampFile: TMPFile; framenumber, channelnumber: integer;
areaRC: TRect);
begin
fMPFile := ampFile;
fChIndex := channelNumber;
fFrameIndex := frameNumber;
Label6.Caption := IntToStr(fChIndex);
MaskEdit1.Text := IntToStr(areaRC.Left);
MaskEdit2.Text := IntToStr(areaRC.Top);
MaskEdit3.Text := IntToStr(areaRC.Right);
MaskEdit4.Text := IntToStr(areaRC.Bottom);
RefreshStats;
end;
procedure TStatDlg.SpeedButton1Click(Sender: TObject);
begin
RefreshStats;
end;
end.
Raw
Track Curser
unit Trackcur;
interface
uses
// Horzbaru declares ancestor of TVertTrackbar: declares methods to
// draw ticks corresponding to grid in scope or viewer
Windows, Messages, Classes, Graphics, Controls, Menus, ExtCtrls,
Horzbaru;
type
TVertTrackBar = class(TCustomTrack)
private
fMax, fMin, fPosition, fScreenPos: integer;
fPageSize: integer;
fSliding: boolean;
fCursorRect: TRect;
fCursor: TObject;
{in screen coordinates:
fMajorTickInterval: interval between major ticks > 0
fFirstMajorTickPos: position of the lowest first tick mark > 0
cMinorTickCount: number of minor ticks between each tick mark > 0}
{fMajorTickInterval, fFirstMajorTickPos, fMinorTickCount: integer;}
fDitherBmp, fCursorBmp, fMaskBmp, fBackgroundBmp: TBitmap;
fOnChange: TNotifyEvent;
function CursorToScreen( Value: integer): integer;
function ScreenToCursor( Value: integer): integer;
function LimitPosition( Value: integer): integer; {clips value to the control}
procedure SetMax( Value : Integer );
procedure SetMin( Value : Integer );
procedure SetPosition( Value : Integer );
function GetScreenPosition: integer;
procedure SetScreenPosition( Value : Integer );
procedure LoadThumbBitmaps;
procedure UpdateDitherBitmap;
procedure DrawTrack;
{ procedure DrawTicks;}
procedure DrawCursor;
procedure WMGetDlgCode( var Msg : TWMGetDlgCode ); message wm_GetDlgCode;
procedure CMEnabledChanged( var Msg : TMessage ); message cm_EnabledChanged;
protected
procedure Paint; override;
procedure Change; dynamic;
procedure DoEnter; override;
procedure DoExit; override;
procedure KeyDown( var Key : Word; Shift : TShiftState ); override;
procedure MouseDown( Button : TMouseButton; Shift : TShiftState; X, Y : Integer ); override;
procedure MouseMove( Shift : TShiftState; X, Y : Integer ); override;
procedure MouseUp( Button : TMouseButton; Shift : TShiftState; X, Y : Integer ); override;
public
constructor Create( AOwner : TComponent ); override;
constructor CreateInCursor( AOwner: TComponent; theCursor: TObject);
destructor Destroy; override;
{procedure SetTickPos(majorInterval, majorPos, minorCount: integer);}
function CursorVisible: boolean;
procedure SetParams(theMax, theMin, thePos: integer);
procedure DrawMajorTicks(pos: integer); override;
procedure DrawMinorTicks(pos: integer); override;
published
property ScreenPos: integer read GetScreenPosition write SetScreenPosition;
property Max : integer read fMax write SetMax default 2250;
property Min : integer read fMin write SetMin default -2250;
property PageSize : integer read fPageSize write fPageSize default 200;
property Position : integer read fPosition write SetPosition;
property OnChange : TNotifyEvent read fOnChange write fOnChange;
{ Inherited Properties & Events }
property Color;
property DragCursor;
property DragMode;
property Enabled;
property HelpContext;
property Hint;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property TabOrder;
property TabStop default True;
property Visible;
property OnClick;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
end;
procedure Register;
implementation
uses SysUtils {, Cursorsu, ViewData};
procedure TVertTrackBar.DrawMajorTicks(pos: integer);
begin
with Canvas do
begin
Pen.Color := clBlack;
Pen.Width := 1;
MoveTo(1, pos);
LineTo(9, pos);
end;
end;
procedure TVertTrackBar.DrawMinorTicks( pos: integer);
begin
with Canvas do
begin
Pen.Color := clBlack;
Pen.Width := 1;
MoveTo(1, pos);
LineTo(5, pos);
end;
end;
function TVertTrackBar.CursorToScreen( Value: integer): integer;
begin
Result := MulDiv(Value - fMax, ClientHeight - 1, fMin - fMax);
if Result < 0 then Result := 0;
if Result >= ClientHeight then Result := ClientHeight - 1;
end;
function TVertTrackBar.ScreenToCursor( Value: integer): integer;
begin
Result := fMax - MulDiv(Value, fMax - fMin, ClientHeight - 1);
end;
function TVertTrackBar.LimitPosition( Value: integer): integer;
begin
Result :=Value;
if Result > fMax then Result := fMax;
if Result < fMin then Result := fMin;
end;
procedure TVertTrackBar.SetMax( Value : Integer );
begin
if value <> fMax then
begin
fMax := Value;
if fPosition > fMax then screenPos := CursorToScreen(fMax);
fPageSize := (fMax - fMin) div 20;
Invalidate;
end;
end;
procedure TVertTrackBar.SetMin( Value : Integer );
begin
if value <> fMin then
begin
fMin := Value;
if fPosition < fMin then screenPos := CursorToScreen(fMin);
fPageSize := (fMax - fMin) div 20;
Invalidate;
end;
end;
procedure TVertTrackBar.SetPosition( Value : Integer );
begin
if value <> fPosition then
begin
fPosition := Value;
if csDesigning in ComponentState then
Invalidate
else
begin
{ Erase old thumb image by drawing background bitmap }
Canvas.Draw( fCursorRect.Left, fCursorRect.Top, FBackgroundBmp );
DrawCursor; { Draw thumb at new location }
Change; { Trigger Change event }
end;
end;
end;
function TVertTrackBar.GetScreenPosition;
begin
Result := CursorToScreen(fPosition);
end;
procedure TVertTrackBar.SetScreenPosition( Value : Integer );
begin
if Value < 0 then Value := 0;
if Value >= ClientHeight then Value := ClientHeight - 1;
fPosition := ScreenToCursor(Value);
Invalidate;
end;
procedure TVertTrackBar.LoadThumbBitmaps;
const
vCursor: PChar = 'VCURSOR';
vMask: PChar = 'VMASK';
begin
fCursorBmp.Handle := LoadBitmap(hInstance, vCursor);
fMaskBmp.Handle := LoadBitmap(hInstance, vMask);
end;
procedure TVertTrackBar.UpdateDitherBitmap;
var
i, j : integer;
begin
with fDitherBmp.Canvas do
begin
Brush.Color := clWhite;
FillRect( Rect( 0, 0, fDitherBmp.Width, fDitherBmp.Height ) );
for i := 0 to 7 do
for j := 0 to 7 do
if ( i + j ) mod 2 <> 0 then
Pixels[ i, j ] := clBlack;
end;
end;
procedure TVertTrackBar.DrawTrack;
begin
Canvas.Brush.Color := clWhite;
if not Enabled then
Canvas.Brush.Bitmap := fDitherBmp;
Canvas.FillRect(ClientRect);
end;
{procedure TVertTrackBar.DrawTicks;
begin
with Owner as TViewer do
if sweepList.Count > 0 then
DrawYTicksOnCursorBars(self, DrawMajorTicks, DrawMinorTicks);
end;}
procedure TVertTrackBar.DrawCursor;
var
offset : integer;
workBmp : TBitmap;
workRct : TRect;
begin
fScreenPos := CursorToScreen(fPosition);
offset := MulDiv(height - 1, fMax - ScreenToCursor(fScreenPos), fMax - fMin);
fCursorRect := Rect(1, offset - 7, 16, offset + 8);
fBackgroundBmp.Width := 15;
fBackgroundBmp.Height := 15;
fBackgroundBmp.Canvas.CopyRect( Rect(0, 0, fCursorBmp.Width, fCursorBmp.Height),
Canvas, fCursorRect );
workBmp := TBitmap.Create;
try
workBmp.Height := fCursorBmp.Height;
workBmp.Width := fCursorBmp.Width;
workRct := Rect( 0, 0, fCursorBmp.Width, fCursorBmp.Height);
workBmp.Canvas.CopyMode := cmSrcCopy;
workBmp.Canvas.CopyRect( WorkRct, fBackgroundBmp.Canvas, workRct );
workBmp.Canvas.CopyMode := cmSrcAnd;
workBmp.Canvas.CopyRect( WorkRct, fMaskBmp.Canvas, WorkRct );
workBmp.Canvas.CopyMode := cmSrcPaint;
WorkBmp.Canvas.CopyRect( WorkRct, fCursorBmp.Canvas, WorkRct );
if not Enabled then
begin
WorkBmp.Canvas.Brush.Bitmap := fDitherBmp;
WorkBmp.Canvas.FloodFill( WorkRct.Right - 3, WorkRct.Bottom - 3,
clSilver, fsSurface );
end;
Canvas.CopyRect( fCursorRect, WorkBmp.Canvas, WorkRct );
finally
workBmp.Free;
end;
end;
procedure TVertTrackBar.WMGetDlgCode( var Msg : TWMGetDlgCode );
begin
inherited;
Msg.Result := dlgc_WantArrows;
end;
procedure TVertTrackBar.CMEnabledChanged( var Msg : TMessage );
begin
inherited;
Invalidate;
end;
procedure TVertTrackBar.Paint;
begin
with Canvas do
begin
DrawTrack;
DrawTicks;
DrawCursor;
end;
end;
procedure TVertTrackBar.Change;
begin
if Assigned( FOnChange ) then FOnChange( Self );
end;
procedure TVertTrackBar.DoEnter;
begin
inherited DoEnter;
Refresh;
end;
procedure TVertTrackBar.DoExit;
begin
inherited DoExit;
Refresh;
end;
procedure TVertTrackBar.KeyDown( var Key : Word; Shift : TShiftState );
begin
inherited KeyDown( Key, Shift );
case Key of
vk_Prior:
Position := LimitPosition(fPosition + fPageSize);
vk_Next:
Position := LimitPosition(fPosition - FPageSize);
vk_End:
Position := fMin;
vk_Home:
Position := fMax;
vk_Left:
if fPosition > fMin then Position := LimitPosition(fPosition - 1);
vk_Up:
if fPosition < fMax then Position := LimitPosition(fPosition + 1);
vk_Right:
if fPosition < fMax then Position := LimitPosition(fPosition + 1);
vk_Down:
if fPosition > fMin then Position := LimitPosition(fPosition - 1);
$30 {VK_0}, $60 {vk_numpad0}:
Position := 0;
end;
end;
procedure TVertTrackBar.MouseDown( Button : TMouseButton; Shift : TShiftState; X, Y : Integer );
var
ptY : integer;
begin
inherited MouseDown( Button, Shift, X, Y );
SetFocus;
if ( Button = mbLeft ) and PtInRect( fCursorRect, Point( X, Y ) ) then
fSliding := True
else
begin
ptY := height - 1 - MulDiv(fPosition - fMin, height, fMax - fMin);
if Y < PtY then
Position := LimitPosition(fPosition + fPageSize)
else
Position := LimitPosition(FPosition - FPageSize);
end;
end;
procedure TVertTrackBar.MouseMove( Shift : TShiftState; X, Y : Integer );
var p, h : Integer;
begin
inherited MouseMove( Shift, X, Y );
if PtInRect( FCursorRect, Point( X, Y ) ) then
Cursor := crSizeNS
else
Cursor := crDefault;
if fSliding then
begin
h := Height - 7;
p:= MulDiv(h - y , fMax - fMin, h) + fMin;
if p > fMax then p := fMax;
if p < fMin then p := fMin;
Position := p;
end;
end;
procedure TVertTrackBar.MouseUp( Button : TMouseButton; Shift : TShiftState; X, Y : Integer );
begin
inherited MouseUp( Button, Shift, X, Y );
if ( Button = mbLeft ) then fSliding := False;
end;
constructor TVertTrackBar.CreateInCursor( AOwner: TComponent; theCursor: TObject);
begin
Create(AOwner);
fCursor := theCursor;
end;
constructor TVertTrackBar.Create( AOwner : TComponent );
begin
inherited Create( AOwner );
Width := 17;
Height := 150;
fMin := -2250;
fMax := +2250;
fPosition := 0;
fPageSize := 200;
fSliding := False;
fCursorBmp := TBitmap.Create;
fCursorBmp.Width := 16;
fCursorBmp.Height := 16;
fMaskBmp := TBitmap.Create;
fBackgroundBmp := TBitmap.Create;
fDitherBmp := TBitmap.Create;
fDitherBmp.Width := 8;
fDitherBmp.Height := 8;
UpdateDitherBitmap;
LoadThumbBitmaps;
end;
destructor TVertTrackBar.Destroy;
begin
fCursorBmp.Free;
fMaskBmp.Free;
fBackgroundBmp.Free;
fDitherBmp.Free;
inherited Destroy;
end;
function TVertTrackBar.CursorVisible: boolean;
begin
if (fPosition <= fMax) and (fPosition >= fMin) then Result := True else Result := False;
end;
procedure TVertTrackBar.SetParams(theMax, theMin, thePos: integer);
begin
fMax := theMax;
fMin := theMin;
fPosition := thePos;
fPageSize := (fMax - fMin) div 20;
end;
procedure Register;
begin
RegisterComponents( 'Samples', [TVertTrackBar] );
end;
end.
Raw
Trans Chanel
unit mtransferdlgu;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Spin, Buttons, ExtCtrls, MPFileu;
type
TMTransferDlg = class(TForm)
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
RadioButton1: TRadioButton;
RadioButton2: TRadioButton;
Label1: TLabel;
SpinEdit1: TSpinEdit;
Label3: TLabel;
SpinEdit2: TSpinEdit;
Bevel1: TBevel;
Label2: TLabel;
Edit1: TEdit;
Label4: TLabel;
SpinEdit3: TSpinEdit;
Label5: TLabel;
ListBox1: TListBox;
Label6: TLabel;
Label7: TLabel;
RadioButton3: TRadioButton;
RadioButton4: TRadioButton;
procedure Edit1Change(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure InitGUI(afile: TMPFile);
function SelectedCh: integer;
end;
var
MTransferDlg: TMTransferDlg;
implementation
{$R *.DFM}
procedure TMTransferDlg.Edit1Change(Sender: TObject);
begin
Label6.Caption := Edit1.Text + '_' + IntToStr(SpinEdit3.Value);
end;
procedure TMTransferDlg.InitGUI(afile: TMPFile);
begin
with afile do
begin
RadioButton1.Checked := (DefaultVideoChannel = 0);
RadioButton2.Checked := (DefaultVideoChannel = 1);
RadioButton3.Checked := (DefaultVideoChannel = 2);
RadioButton4.Checked := (DefaultVideoChannel = 3);
if VideoChCount = 1 then
begin
RadioButton1.Enabled := False;
RadioButton2.Enabled := False;
RadioButton3.Enabled := False;
RadioButton4.Enabled := False;
end
else
begin
RadioButton1.Enabled := ChEnabled[0];
RadioButton2.Enabled := ChEnabled[1];
RadioButton3.Enabled := ChEnabled[2];
RadioButton4.Enabled := ChEnabled[3];
end;
end;
end;
function TMTransferDlg.SelectedCh: integer;
begin
if RadioButton1.Checked then
Result := 0
else if RadioButton2.Checked then
Result := 1
else if RadioButton3.Checked then
Result := 2
else if RadioButton4.Checked then
Result := 3
else
Result := 0;
end;
end.
Raw
Vert Button
unit Vertbtn;
interface
uses
SysUtils, Windows, Messages, Classes, Graphics, Controls,
Forms, Dialogs, Buttons;
type
TCaptionOrientation = (coHorizontal, coVertical);
TVertBtn = class(TSpeedButton)
private
{ Private declarations }
fOrientation: TCaptionOrientation;
fFirstLine: string;
fSecondLine: string;
procedure SetCaptionOrientation(value: TCaptionOrientation);
procedure SetFirstLine(value: string);
procedure SetSecondLine(value: string);
protected
{ Protected declarations }
procedure Paint; override;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
published
{ Published declarations }
property FirstLine: string read fFirstLine write SetFirstLine;
property SecondLine: string read fSecondLine write SetSecondLine;
property Orientation: TCaptionOrientation read fOrientation write SetCaptionOrientation;
end;
procedure Register;
implementation
constructor TVertBtn.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
controlStyle := controlStyle + [csOpaque];
end;
procedure TVertBtn.SetCaptionOrientation(value: TCaptionOrientation);
begin
fOrientation := value;
Refresh;
end;
procedure TVertBtn.Paint;
var tempLogFont: TLogFont;
oldFontHandle, newFontHandle: THandle;
x ,y: integer;
begin
inherited Paint;
if (fFirstLine = '') and (fSecondLine = '') then Exit;
with inherited Canvas do
begin
GetObject(Font.Handle, SizeOf(TLogFont), addr(tempLogFont));
if fOrientation = coVertical then tempLogFont.lfEscapement := 900;
tempLogFont.lfWeight := FW_BOLD;
newFontHandle := CreateFontIndirect(tempLogFont);
oldFontHandle := SelectObject(Handle, newFontHandle);
SetBkMode(Handle, Windows.TRANSPARENT);
if fOrientation = coVertical then
begin
if fFirstLine = '' then
begin
x := (Width - TextHeight(fSecondLine)) div 2;
y := Height - (Height - TextWidth(fSecondLine)) div 2;
TextOut(x, y, fSecondLine);
end
else if fSecondLine = '' then
begin
x := (Width - TextHeight(fFirstLine)) div 2;
y := Height - (Height - TextWidth(fFirstLine)) div 2;
TextOut(x, y, fFirstLine);
end
else
begin
x := (Width - TextHeight(fFirstLine) - TextHeight(fSecondLine)) div 3;
y := Height - (Height - TextWidth(fFirstLine)) div 2;
TextOut(x, y, fFirstLine);
y := Height - (Height - TextWidth(fSecondLine)) div 2;
TextOut(2 * x + TextHeight(fFirstLine), y, fSecondLine);
end;
end
else
begin
if fFirstLine = '' then
begin
x := (Width - TextWidth(fSecondLine)) div 2;
y := Height - (Height - TextHeight(fSecondLine)) div 2;
TextOut(x, y, fSecondLine);
end
else if fSecondLine = '' then
begin
x := (Width - TextWidth(fFirstLine)) div 2;
y := Height - (Height - TextHeight(fFirstLine)) div 2;
TextOut(x, y, fFirstLine);
end
else
begin
x := (Width - TextWidth(fFirstLine)) div 2;
y := (Height - TextHeight(fFirstLine) - TextHeight(fSecondLine)) div 3;
TextOut(x, y, fFirstLine);
x := (Width - TextWidth(fSecondLine)) div 2;
y := 2 * y + TextHeight(fFirstLine);
TextOut(x, y, fSecondLine);
end;
end;
SetBkMode(Handle, Windows.OPAQUE);
DeleteObject(SelectObject(Handle, oldFontHandle));
end;
end;
procedure TVertBtn.SetFirstLine(value: string);
begin
fFirstLine := value;
end;
procedure TVertBtn.SetSecondLine(value: string);
begin
fSecondLine := value;
end;
procedure Register;
begin
RegisterComponents('Samples', [TVertBtn]);
end;
end.
Raw
View
unit mpviewu;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Forms, StdCtrls, COMObj,
ActiveX, Registry;
const
MAX_ANALOG_CH_COUNT = 2;
MAX_VIDEO_CH_COUNT = 2;
MAX_CH = 4;
f_MAX_Y_VALUE = 2047;
BASE_CLOCK = 5e-8; {50 ns base clock = 20 MHz clock frequency}
{the GUID for multiphoton data files}
GUID_MPD: TGUID = '{5BC02769-74F0-47DF-929E-2E5D3630D9B5}';
CR = Chr(13);
TAB = Chr(9);
CRLF = #13#10;
MAX_FALSE_COLORS = 2048;
MAX_GRAY_LEVELS = 256;
DEFAULT_MAX_PIXEL_VALUE = 2047;
// TypeLibrary Major and minor versions for Matlab
MLAppMajorVersion = 1;
MLAppMinorVersion = 0;
LIBID_MLApp: TGUID = '{554F6052-79D4-11D4-B067-009027BA5F81}';
IID_IMLApp: TGUID = '{669CEC92-6E22-11CF-A4D6-00A024583C19}';
IID_IMLEval: TGUID = '{27BEA9CE-A20C-430F-87C2-1CC8BA31C3A8}';
DIID_DIMLApp: TGUID = '{669CEC93-6E22-11CF-A4D6-00A024583C19}';
DIID_DIMLEval: TGUID = '{6E813920-23FE-4D6D-91F8-56FAB06C5D13}';
CLASS_MLApp_: TGUID = '{554F6053-79D4-11D4-B067-009027BA5F81}';
CLASS_MLEval: TGUID = '{00854C9D-4827-4BC5-8A7D-770E696DF6A3}';
slutType = 'Lut Type';
type
int16 = smallint;
int32 = integer;
TFrameResolution = (RESOLUTION_8_BITS, RESOLUTION_12_BITS, RESOLUTION_16_BITS);
TChannelResolution = TFrameResolution;
TPrecision = (PREC_8_BIT, PREC_10_BIT, PREC_12_BIT, PREC_14_BIT, PREC_16_BIT);
TFullScaleVal = (pm_42V, pm_20V, pm_10V, pm_5V, pm_2V, pm_1V, pm_0_5V, pm_0_2V);
TInputRange = Set Of TFullScaleVal;
TPrefix = ( tpXENNO, tpYOCTO, tpZEPTO, tpATTO, tpFEMTO, tpPICO, tpNANO,
tpMICRO, tpMILLI, tpUNITY, tpKILO, tpMEGA, tpGIGA, tpTERA, tpPETA,
tpECTA, tpZETTA, tpYOTTA, tpXENNA, tpZERO, tpNONE );
TScanMode = (SM_MOVIE, SM_STACK, SM_LINESCAN, SM_REPEAT_LINESCAN, SM_REGIONSCAN,
SM_FASTSTACK);
TRGBTripleArray = array[0..Maxint div 8] of TRGBTriple;
TpRGBTripleArray = ^TRGBTripleArray;
TColorScheme = (CS_GRAYSCALE, CS_FALSECOLORS, CS_CUSTOMLUT);
{*****************************************************************************}
{* FILES *}
{*****************************************************************************}
TFileErr = (feOK,
feCannotFindFile,
fePathNotFound,
feTooManyFilesOpened,
feAccessDenied,
feBadFileType,
feBadVersion,
feForceConversion,
feDiskFull,
feFileIsNotStorage,
feOutOfMemory,
feBadDiskDrive,
feCannotReadFile,
feUnknownError,
feBadData,
feUnexpectedEOF,
feShareViolation,
feInvalidHandle,
feFileNotAssigned,
feFileNotOpen,
feFileNotOpenForInput,
feFileNotOpenForOutput,
feInvalidInput,
feInvalidName,
feNotAMPFile,
feFileAlreadyOpen
);
TStorageNameErr = (sneOK, sneInvalidName, sneTooLong, sneInvalidChar, sneNumChar,
sneReservedName, sneAlreadyExists);
TBaseColorsArray = array[0..MAX_CH - 1 {channel index}, 0..2 {RGB}] of boolean;
TRangeColorsArray = array[0..MAX_CH - 1] of TRGBTriple;
TMaxPixelsArray = array[0..MAX_CH - 1] of integer;
//******************************** GRAPHICS *********************************
TMinMaxPt = record
MaxPt, MinPt: TPoint;
end;
TTrace = array of TMinMaxPt;
TpTrace = ^TTrace;
//*************************** REGION OF INTEREST ****************************
TSimpleROI = class
private
function GetCenter: TPoint; virtual; abstract;
function GetPixels(pixindex: integer): TPoint; virtual; abstract;
function GetPixelCount: integer; virtual; abstract;
public
fchannel, fROIIndex: integer;
procedure Draw(aBitmap: TBitmap; xOffset: integer); virtual; abstract;
function PtInROI(aPt: TPoint): boolean; virtual; abstract;
property Channel: integer read fChannel;
property Center: TPoint read GetCenter;
property PixelCount: integer read GetPixelCount;
property Pixels[pixindex: integer]: TPoint read GetPixels;
end;
TRectangularROI = class(TSimpleROI)
private
function GetCenter: TPoint; override;
function GetPixels(pixindex: integer): TPoint; override;
function GetPixelCount: integer; override;
public
roiRect: TRect;
procedure Draw(aBitmap: TBitmap; xOffset: integer); override;
function PtInROI(pt: TPoint): boolean; override;
end;
TEllipticalROI = class(TSimpleROI)
private
ellipticalRegion: THandle;
fPixelCount: integer;
pixelArray: array of TPoint;
function GetCenter: TPoint; override;
function GetPixels(pixindex: integer): TPoint; override;
function GetPixelCount: integer; override;
public
roiRect: TRect;
procedure Draw(aBitmap: TBitmap; xOffset: integer); override;
procedure FindPixels;
function PtInROI(pt: TPoint): boolean; override;
destructor Destroy; override;
end;
TObjectROI = class(TSimpleROI)
private
ptsList: TList;
function GetCenter: TPoint; override;
function GetPixels(pixindex: integer): TPoint; override;
function GetPixelCount: integer; override;
public
procedure Draw(aBitmap: TBitmap; xOffset: integer); override;
function PtInROI(pt: TPoint): boolean; override;
procedure AddPt(pt: TPoint);
constructor Create;
destructor Destroy; override;
end;
TROIList = class(TList)
public
procedure AddRectangularROI(chIndex: integer; rc: TRect);
procedure AddEllipticalROI(chIndex: integer; rc: TRect);
function GetROIs(roiIndex: integer): TSimpleROI;
function PtInObject(aPt: TPoint): TObjectROI;
function ROIOfPt(chIndex: integer; aPt: TPoint): integer;
procedure Clear; override;
destructor Destroy; override;
property ROIs[roiIndex: integer]: TSimpleROI read GetROIs;
end;
// ============================ Registry Methods ===============================
function StrParse(var fullStr: string; delim: Char): string;
procedure SavePosToRegistry(aForm: TForm; regini: TRegistryIniFile; const section, entry: string);
procedure RestorePosFromRegistry(aForm: TForm; regini: TRegistryIniFile; const section, entry: string;
bMainForm: boolean);
{*****************************************************************************}
{* Transfer functions *}
{*****************************************************************************}
function PrefixToString(prefix: TPrefix): string;
function PrefixToExponent(prefix: TPrefix): integer;
function PrefixToFactor(prefix: TPrefix): double;
function ExpToPrefixString(exponent: integer): string;
function GetPrefixFromValue(value: double): TPrefix;
{*****************************************************************************}
{* List Box Functions *}
{*****************************************************************************}
{this procedure initializes a list box with prefixes and unit}
procedure FillUnitListBox(listBox: TComboBox; sUnit: string);
{this function returns the index of the prefix in a list box filled with prefix-unit}
function UnitPrefixToListBoxIndex(prefix: integer): integer;
function ListBoxIndexToUnitPrefix(listBoxIndex: integer): integer;
procedure FillInputRangeListBox(listBox: TComboBox); {fill a list box with ns, us, etc...}
function InputRangeToString(inputRange: TFullScaleVal): string;
function FullScaleToVal(fs: TFullScaleVal): double;
// ============================ File I/O Methods ===============================
function IOErrToFileErr(code: integer): TFileErr;
function FileErrToStr(fe: TFileErr): string;
function StgErrToFileErr(hr: HResult): TFileErr;
// ============================ Miscellaneous ==================================
function FindCommonRegion(start1, end1, start2, end2: integer;
var commonStart, commonEnd: integer): boolean;
procedure NormalizeRect(var rect: TRect);
function PrecisionToString(aPrecision: TPrecision): string;
function PointStrictlyInRect(const aPt: TPoint; aRect: TRect): boolean;
function ScanModeToString(smode: TScanMode): string;
procedure MakeRectFromPts(left, top, right, bottom: integer; var rectarray: array of TPoint);
{******************************************************************************}
{*} {*}
{*} IMPLEMENTATION {*}
{*} {*}
{******************************************************************************}
uses Math, inifiles, Dialogs;
resourcestring
// FILE I/O ERRORS
sIOErr_FileNotFound = 'File not found.';
sIOErr_PathNotFound = 'Path not found.';
sIOErr_TooManyOpenFiles = 'Too many open files.';
sIOErr_AccessDenied = 'File access denied.';
sIOErr_InvalidHandle = 'Invalid file handle.';
sIOErr_NotEnoughMemory = 'Insufficient memory for this operation.';
sIOErr_InvalidFileAccessCode = 'Invalid file access code.';
sIOErr_InvalidData = 'Invalid data.';
sIOErr_NotEnoughStorage = 'Not enough storage.';
sIOErr_InvalidDrive = 'Invalid drive.';
sIOErr_CannotWrite = 'Error writing to file.';
sIOErr_CannotRead = 'Error reading from file.';
sIOErr_SharingViolation = 'Share violation error.';
sIOErr_EOF = 'Disk read error, read past end of file.';
sIOErr_DiskFull = 'Disk write error, disk full.';
sIOErr_FileNotAssigned = 'File not assigned.';
sIOErr_NotACompoundFile = 'Invalid file.';
sIOErr_InvalidName = 'Invalid file name.';
sIOErr_Unexpected = 'Unexpected error.';
sIOErr_InvalidFileType = 'Invalid file type.';
sIOErr_InvalidVersion = 'Invalid file version.';
sIOErr_FileIsNotStorage = 'The file is not a compound file.';
sIOErr_BadData = 'Corrupted data in file.';
sIOErr_ForceConversion = 'Forced file conversion.';
sIOErr_FileNotOpen = 'File not opened.';
sIOErr_FileNotOpenForInput = 'File not opened for input.';
sIOErr_FileNotOpenForOutput = 'File not opened for output.';
sIOErr_InvalidInput = 'Invalid input.';
sIOErr_NotAMPFile = 'The file is not a MP data file.';
sIOErr_FileAlreadyOpen = 'The file is already opened.';
// Storage name error
sSNE_InvalidName = 'Invalid name.';
sSNE_TooLong = 'Name too long.';
sSNE_InvalidChar = 'Invalid character in name.';
sSNE_NumChar = 'Invalid numerical character in name.';
sSNE_ReservedName = 'Reserved name.';
sSNE_AlreadyExist = 'Name already exists.';
type
EMPConfig = class(Exception);
TPropSpecArray = array[0..1000] of TPropSpec;
TpPropSpecArray = ^TPropSpecArray;
TPropVariantArray = array[0..1000] of TPropVariant;
TpPropVariantArray = ^TPropVariantArray;
TStatPropStgArray = array[0..1000] of TStatPropStg;
TpStatPropStgArray = ^TStatPropStgArray;
const
FMTID_User_Defined_Properties: TGUID = '{D5CDD505-2E9C-101B-9397-08002B2CF9AE}';
sAlreadyLoaded = '%s' + CRLF + 'is already open.';
function PrecisionToString(aPrecision: TPrecision): string;
begin
case aPrecision of
PREC_8_BIT: Result := '8-bit';
PREC_10_BIT: Result := '10-bit';
PREC_12_BIT: Result := '12-bit';
PREC_14_BIT: Result := '14-bit';
else Result := '16-bit';
end;
end;
procedure MakeRectFromPts(left, top, right, bottom: integer; var rectarray: array of TPoint);
begin
rectarray[0].x := left; rectarray[0].y := top;
rectarray[1].x := right; rectarray[1].y := top;
rectarray[2].x := right; rectarray[2].y := bottom;
rectarray[3].x := left; rectarray[3].y := bottom;
rectarray[4].x := left; rectarray[4].y := top;
end;
// ============================ Registry Methods ===============================
function StrParse(var fullStr: string; delim: Char): string;
var delimPos: integer;
begin
delimPos := Pos(delim, fullStr);
if delimPos > 0 then
begin
Result := Copy(fullStr,1,Pred(delimPos));
fullStr := Copy(fullStr,Succ(delimPos),Length(fullStr));
end
else
Result := fullStr;
end;
procedure SavePosToRegistry(aForm: TForm; regini: TRegistryIniFile; const section, entry: string);
var buffer: array[0..79] of Char;
windowPlacement: TWindowPlacement;
begin
windowPlacement.Length := SizeOf(windowPlacement);
GetWindowPlacement(aForm.Handle, @windowPlacement);
WVSPrintf(buffer, '%i,%i,%i,%i,%i,%i,%i,%i,%i,%i,%i', @windowPlacement);
regini.WriteString(section, entry, StrPas(buffer));
end;
procedure RestorePosFromRegistry(aForm: TForm; regini: TRegistryIniFile; const section, entry: string;
bMainForm: boolean);
var buffer: string;
windowPlacement: TWindowPlacement;
begin
buffer := regini.ReadString(section, entry, '');
FillChar(windowPlacement, SizeOf(windowPlacement), 0);
windowPlacement.Length := SizeOf(windowPlacement);
if buffer <> '' then
begin
StrToIntDef(StrParse(buffer, ','), 0);
with windowPlacement do
begin
flags := StrToInt(StrParse(buffer, ','));
showCmd := StrToInt(StrParse(buffer, ','));
ptMinPosition.x := StrToInt(StrParse(buffer, ','));
ptMinPosition.y := StrToInt(StrParse(buffer, ','));
ptMaxPosition.x := StrToInt(StrParse(buffer, ','));
ptMaxPosition.y := StrToInt(StrParse(buffer, ','));
rcNormalPosition.Left := StrToInt(StrParse(buffer, ','));
rcNormalPosition.Top := StrToInt(StrParse(buffer, ','));
rcNormalPosition.Right := StrToInt(StrParse(buffer, ','));
rcNormalPosition.Bottom := StrToInt(StrParse(buffer, ','));
case ShowCmd of
sw_showMinimized,
sw_showminnoactive,
sw_minimize:
aForm.WindowState := wsMinimized;
sw_showmaximized:
aForm.WindowState := wsMaximized;
end;
end;
SetWindowPlacement(aForm.Handle, @windowPlacement);
end
else
if bMainForm then
with windowPlacement do
begin
showCmd := SW_SHOW;
if not SystemParametersInfo(SPI_GETWORKAREA, 0, @rcNormalPosition, 0) then
rcNormalPosition := Rect(0, 0, 799, 599);
SetWindowPlacement(aForm.Handle, @windowPlacement);
end;
end;
{*****************************************************************************}
{* Transfer functions *}
{*****************************************************************************}
function PrefixToString(prefix: TPrefix): string;
begin
case prefix of
tpXENNO: Result := 'x';
tpYOCTO: Result := 'y';
tpZEPTO: Result := 'z';
tpATTO: Result := 'a';
tpFEMTO: Result := 'f';
tpPICO: Result := 'p';
tpNANO: Result := 'n';
tpMICRO: Result := #181;
tpMILLI: Result := 'm';
tpUNITY : Result := '';
tpKILO: Result := 'k';
tpMEGA: Result := 'M';
tpGIGA: Result := 'G';
tpTERA: Result := 'T';
tpPETA: Result := 'P';
tpECTA: Result := 'E';
tpZETTA: Result := 'Z';
tpYOTTA: Result := 'Y';
tpXENNA: Result := 'X';
tpNONE: Result := '';
else
Result := '';
end;
end;
function PrefixToFactor(prefix: TPrefix): double;
begin
case prefix of
tpXENNO: Result := 1E-27;
tpYOCTO: Result := 1E-24;
tpZEPTO: Result := 1E-21;
tpATTO: Result := 1E-18;
tpFEMTO: Result := 1E-15;
tpPICO: Result := 1E-12;
tpNANO: Result := 1E-9;
tpMICRO: Result := 1E-6;
tpMILLI: Result := 1E-3;
tpUNITY : Result := 1;
tpKILO: Result := 1E+3;
tpMEGA: Result := 1E+6;
tpGIGA: Result := 1E+9;
tpTERA: Result := 1E+12;
tpPETA: Result := 1E+15;
tpECTA: Result := 1E+18;
tpZETTA: Result := 1E+21;
tpYOTTA: Result := 1E+24;
tpXENNA: Result := 1E+27;
tpNONE: Result := 1;
else
Result := 1;
end;
end;
function PrefixToExponent(prefix: TPrefix): integer;
begin
case prefix of
tpXENNO: Result := -27;
tpYOCTO: Result := -24;
tpZEPTO: Result := -21;
tpATTO: Result := -18;
tpFEMTO: Result := -15;
tpPICO: Result := -12;
tpNANO: Result := -9;
tpMICRO: Result := -6;
tpMILLI: Result := -3;
tpUNITY : Result := 0;
tpKILO: Result := +3;
tpMEGA: Result := +6;
tpGIGA: Result := +9;
tpTERA: Result := +12;
tpPETA: Result := +15;
tpECTA: Result := +18;
tpZETTA: Result := +21;
tpYOTTA: Result := +24;
tpXENNA: Result := +27;
tpNONE: Result := 0;
else
Result := 0;
end;
end;
function ExpToPrefixString(exponent: integer): string;
begin
case exponent of
-27: Result := 'x';
-24: Result := 'y';
-21: Result := 'z';
-18: Result := 'a';
-15: Result := 'f';
-12: Result := 'p';
-9: Result := 'n';
-6: Result := #181;
-3: Result := 'm';
0 : Result := '';
3: Result := 'k';
6: Result := 'M';
9: Result := 'G';
12: Result := 'T';
15: Result := 'P';
18: Result := 'E';
21: Result := 'Z';
24: Result := 'Y';
27: Result := 'X';
else
Result := '';
end;
end;
{This function chooses the most appropriate prefix for the value
if value is too small, returns tpZERO}
function GetPrefixFromValue(value: double): TPrefix;
begin
value := Abs(value);
if value <= 1E-30 then
Result := tpZERO
else if value < 1E-24 then
Result := tpXENNO
else if value < 1E-21 then
Result := tpYOCTO
else if value < 1E-18 then
Result := tpZEPTO
else if value < 1E-15 then
Result := tpATTO
else if value < 1E-12 then
Result := tpFEMTO
else if value < 1E-9 then
Result := tpPICO
else if value < 1E-6 then
Result := tpNANO
else if value < 1E-3 then
Result := tpMICRO
else if value < 1E-0 then
Result := tpMILLI
else if value < 1E+3 then
Result := tpUNITY
else if value < 1E+6 then
Result := tpKILO
else if value < 1E+9 then
Result := tpMEGA
else if value < 1E+12 then
Result := tpGIGA
else if value < 1E+15 then
Result := tpTERA
else if value < 1E+18 then
Result := tpPETA
else if value < 1E+21 then
Result := tpECTA
else if value < 1E+24 then
Result := tpZETTA
else if value < 1E+27 then
Result := tpYOTTA
else if value < 1E+30 then
Result := tpXENNA
else
Result := tpXENNA;
end;
{*****************************************************************************}
{* List Box Functions *}
{*****************************************************************************}
procedure FillUnitListBox(listBox: TComboBox; sUnit: string);
begin
with listBox, listBox.Items do
begin
Clear;
Add('x' + sUnit);
Add('y' + sUnit);
Add('z' + sUnit);
Add('a' + sUnit);
Add('f' + sUnit);
Add('p' + sUnit);
Add('n' + sUnit);
Add(#181 + sUnit);
Add('m' + sUnit);
Add(sUnit);
Add('k' + sUnit);
Add('M' + sUnit);
Add('G' + sUnit);
Add('T' + sUnit);
Add('P' + sUnit);
Add('E' + sUnit);
Add('Z' + sUnit);
Add('Y' + sUnit);
Add('X' + sUnit);
end;
end;
function UnitPrefixToListBoxIndex(prefix: integer): integer;
begin
Result := (27 + prefix) div 3;
end;
function ListBoxIndexToUnitPrefix(listBoxIndex: integer): integer;
begin
Result := listBoxIndex * 3 - 27;
end;
procedure FillTimeListBox(listBox: TComboBox); {fill a list box with ns, us, etc...}
begin
with listBox, listBox.Items do
begin
Clear;
Add('ns');
Add(Chr(181) + 's');
Add('ms');
Add('s');
Add('min');
Add('hr');
end;
end;
procedure FillInputRangeListBox(listBox: TComboBox);
var i: TFullScaleVal;
begin
with listBox, listBox.Items do
begin
Clear;
for i := pm_42V to pm_0_2V do
Add(InputRangeToString(i));
end;
end;
function FullScaleToVal(fs: TFullScaleVal): double;
begin
case fs of
pm_42V: Result := 42.0;
pm_20V: Result := 20.0;
pm_10V: Result := 10.0;
pm_5V: Result := 5.0;
pm_2V: Result := 2.0;
pm_1V: Result := 1.0;
pm_0_5V: Result := 0.5;
pm_0_2V: Result := 0.2;
else
Result := 0;
end;
end;
function InputRangeToString(inputRange: TFullScaleVal): string;
begin
case inputRange of
pm_42V: Result := Chr(177) + '42V';
pm_20V: Result := Chr(177) + '20V';
pm_10V: Result := Chr(177) + '10V';
pm_5V: Result := Chr(177) + '5V';
pm_2V: Result := Chr(177) + '2V';
pm_1V: Result := Chr(177) + '1V';
pm_0_5V: Result := Chr(177) + '0.5V';
pm_0_2V: Result := Chr(177) + '0.2V';
else
Result := '';
end;
end;
function ScanModeToString(smode: TScanMode): string;
begin
case smode of
SM_MOVIE: Result := 'Movie';
SM_STACK: Result := 'Image Stack';
SM_LINESCAN: Result := 'Line Scan';
SM_REPEAT_LINESCAN: Result := 'Repeat Line Scan';
SM_REGIONSCAN: Result := 'Region Scan';
else Result := 'Fast Stack';
end
end;
function IOErrToFileErr(code: integer): TFileErr;
begin
case code of
2: Result := feCannotFindFile;
3: Result := fePathNotFound;
4: Result := feTooManyFilesOpened;
5: Result := feAccessDenied;
6: Result := feInvalidHandle;
8: Result := feOutOfMemory;
100: Result := feUnexpectedEOF;
101: Result := feDiskFull;
102: Result := feFileNotAssigned;
103: Result := feFileNotOpen;
104: Result := feFileNotOpenForInput;
105: Result := feFileNotOpenForOutput;
106: Result := feInvalidInput;
else
Result := feUnknownError;
end;
end;
function FileErrToStr(fe: TFileErr): string;
begin
case fe of
feCannotFindFile: Result := sIOErr_FileNotFound;
fePathNotFound: Result := sIOErr_PathNotFound;
feTooManyFilesOpened: Result := sIOErr_TooManyOpenFiles;
feAccessDenied: Result := sIOErr_AccessDenied;
feBadFileType: Result := sIOErr_InvalidFileType;
feBadVersion: Result := sIOErr_InvalidVersion;
feForceConversion: Result := sIOErr_ForceConversion;
feDiskFull: Result := sIOErr_DiskFull;
feFileIsNotStorage: Result := sIOErr_FileIsNotStorage;
feOutOfMemory: Result := sIOErr_NotEnoughMemory;
feBadDiskDrive: Result := sIOErr_InvalidDrive;
feCannotReadFile: Result := sIOErr_CannotRead;
feUnknownError: Result := sIOErr_Unexpected;
feBadData: Result := sIOErr_BadData;
feUnexpectedEOF: Result := sIOErr_EOF;
feShareViolation: Result := sIOErr_SharingViolation;
feInvalidHandle: Result := sIOErr_InvalidHandle;
feFileNotAssigned: Result := sIOErr_FileNotAssigned;
feFileNotOpen: Result := sIOErr_FileNotOpen;
feFileNotOpenForInput: Result := sIOErr_FileNotOpenForInput;
feFileNotOpenForOutput: Result := sIOErr_FileNotOpenForOutput;
feInvalidInput: Result := sIOErr_InvalidInput;
feInvalidName: Result := sIOErr_InvalidName;
feNotAMPFile: Result := sIOErr_NotAMPFile;
feFileAlreadyOpen: Result := sIOErr_FileAlreadyOpen;
else
Result := sIOErr_Unexpected;
end;
end;
// *****************************************************************************
//
// ROI Methods
//
// *****************************************************************************
// *************************** Rectangular ROI *********************************
function TRectangularROI.GetCenter: TPoint;
begin
Result.x := (roiRect.Right + roiRect.Left) div 2;
Result.y := (roiRect.Bottom + roiRect.Top) div 2;
end;
function TRectangularROI.GetPixels(pixindex: integer): TPoint;
var rWidth, yOffset: integer;
begin
rWidth := roiRect.Right - roiRect.Left + 1;
yOffset := pixIndex div rWidth;
Result.x := roiRect.Left + pixindex - yOffset * rWidth;
Result.y := roiRect.Top + yOffset;
end;
function TRectangularROI.GetPixelCount: integer;
begin
Result := (roiRect.Right - roiRect.Left + 1) * (roiRect.Bottom - roiRect.Top + 1);
end;
procedure TRectangularROI.Draw(aBitmap: TBitmap; xOffset: integer);
{var s: string;
sWidth, sHeight: integer;}
begin
if fChannel = 0 then xOffset := 0;
with aBitmap.Canvas do
begin
Pen.Color := clWhite;
Pen.Style := psDot;
Pen.Width := 1;
Pen.Mode := pmCopy;
Polyline([Point(roiRect.Left + xOffset, roiRect.Top),
Point(roiRect.Right + xOffset, roiRect.Top),
Point(roiRect.Right + xOffset, roiRect.Bottom),
Point(roiRect.Left + xOffset, roiRect.Bottom),
Point(roiRect.Left + xOffset, roiRect.Top)]);
{ TextFlags := 0;
Font.Name := 'Arial';
Font.Color := clWhite;
Font.Size := 10;
s := IntToStr(fROIIndex);
sWidth := TextWidth(s);
sHeight := TextHeight(s);
TextOut(Center.x + xOffset - sWidth div 2, Center.y - sHeight div 2, s);}
end;
end;
function TRectangularROI.PtInROI(pt: TPoint): boolean;
begin
Result := PointStrictlyInRect(pt, roiRect);
end;
type TPPoint = ^TPoint;
function TObjectROI.GetCenter: TPoint;
var i: integer;
ppt: TPPoint;
begin
Result.x := 0;
Result.y := 0;
if ptsList.Count > 0 then
begin
for i := 0 to ptsList.Count - 1 do
begin
ppt := TPPoint(ptsList.Items[i]);
Result.x := Result.x + ppt^.x;
Result.y := Result.y + ppt^.y;
end;
Result.x := Result.x div ptsList.Count;
Result.y := Result.y div ptsList.Count;
end;
end;
// *************************** Elliptical ROI *********************************
function TEllipticalROI.GetCenter: TPoint;
begin
Result.x := (roiRect.Right + roiRect.Left) div 2;
Result.y := (roiRect.Bottom + roiRect.Top) div 2;
end;
function TEllipticalROI.GetPixels(pixindex: integer): TPoint;
begin
if pixindex < PixelCount then
Result := pixelArray[pixindex]
else
Result := Point(0, 0);
end;
function TEllipticalROI.GetPixelCount: integer;
begin
Result := fPixelCount;
end;
procedure TEllipticalROI.FindPixels;
var i, j, nextPt: integer;
begin
ellipticalRegion := CreateEllipticRgnIndirect(roiRect);
fPixelCount := 0;
for i := roiRect.Top to roiRect.Bottom do
for j := roiRect.Left to roiRect.Right do
if PtInRegion(ellipticalRegion, j, i) then
fPixelCount := fPixelCount + 1;
SetLength(pixelArray, fPixelCount);
nextPt := 0;
for i := roiRect.Top to roiRect.Bottom do
for j := roiRect.Left to roiRect.Right do
if PtInRegion(ellipticalRegion, j, i) then
begin
pixelArray[nextPt] := Point(j, i);
nextPt := nextPt + 1;
end;
end;
procedure TEllipticalROI.Draw(aBitmap: TBitmap; xOffset: integer);
begin
if fChannel = 0 then xOffset := 0;
with aBitmap.Canvas do
begin
Pen.Color := clWhite;
Pen.Style := psDot;
Pen.Width := 1;
Pen.Mode := pmCopy;
Arc(roiRect.Left + xOffset,
roiRect.Top,
roiRect.Right + xOffset,
roiRect.Bottom,
roiRect.Left + xOffset,
roiRect.Top,
roiRect.Left + xOffset,
roiRect.Top);
end;
end;
function TEllipticalROI.PtInROI(pt: TPoint): boolean;
begin
Result := PtInRegion(ellipticalRegion, pt.x, pt.y);
end;
destructor TEllipticalROI.Destroy;
begin
DeleteObject(ellipticalRegion);
inherited Destroy;
end;
// *************************** Object ROI *********************************
function TObjectROI.GetPixels(pixindex: integer): TPoint;
var ppt: TPPoint;
begin
ppt := TPPoint(ptsList.Items[pixindex]);
Result.x := ppt^.x;
Result.y := ppt^.y;
end;
function TObjectROI.GetPixelCount: integer;
begin
Result := ptsList.Count;
end;
procedure TObjectROI.Draw(aBitmap: TBitmap; xOffset: integer);
var { s: string;
sWidth, sHeight: integer;}
pLine: TpRGBTripleArray;
pt : TPoint;
pPixel : ^TRGBTriple;
i: integer;
begin
if fChannel = 0 then xOffset := 0;
if ptsList.Count < 0 then Exit;
for i := 0 to PixelCount - 1 do
begin
pt := Pixels[i];
pLine := aBitmap.ScanLine[pt.y];
pPixel := @pLine[xOffset + pt.x];
pPixel^.rgbtBlue := 255;
pPixel^.rgbtGreen := 255;
pPixel^.rgbtRed := 255;
end;
{ with aBitmap.Canvas do
begin
Font.Name := 'Arial';
Font.Color := clBlack;
Font.Size := 10;
s := IntToStr(fROIIndex);
sWidth := TextWidth(s);
sHeight := TextHeight(s);
TextOut(Center.x + xOffset - sWidth div 2, Center.y - sHeight div 2, s);
end; }
end;
function TObjectROI.PtInROI(pt: TPoint): boolean;
var i: integer;
ppt: TPPoint;
begin
Result := False;
i := 0;
if ptsList.Count > 0 then
while not Result and (i < ptsList.Count) do
begin
ppt := TPPoint(ptsList.Items[i]);
if (ppt^.x = pt.x) and (ppt^.y = pt.y) then
Result := True
else
i := i + 1;
end;
end;
procedure TObjectROI.AddPt(pt: TPoint);
var ppt: TPPoint;
begin
GetMem(ppt, SizeOf(TPoint));
ppt^.x := pt.x;
ppt^.y := pt.y;
ptsList.Add(ppt);
end;
constructor TObjectROI.Create;
begin
ptsList := TList.Create;
ptsList.Capacity := 1000;
end;
destructor TObjectROI.Destroy;
var i: integer;
begin
if ptsList.Count >= 0 then
for i := 0 to ptsList.Count - 1 do
Freemem(ptsList.Items[i], SizeOf(TPoint));
ptsList.Free;
inherited Destroy;
end;
procedure TROIList.AddRectangularROI(chIndex: integer; rc: TRect);
var aRectROI: TRectangularROI;
begin
NormalizeRect(rc);
aRectROI := TRectangularROI.Create;
aRectROI.fchannel := chIndex;
aRectROI.fROIIndex := Count + 1;
aRectROI.roiRect := rc;
Add(aRectROI);
end;
procedure TROIList.AddEllipticalROI(chIndex: integer; rc: TRect);
var aEllROI: TEllipticalROI;
begin
NormalizeRect(rc);
aEllROI := TEllipticalROI.Create;
aEllROI.fchannel := chIndex;
aEllROI.fROIIndex := Count + 1;
aEllROI.roiRect := rc;
aEllROI.FindPixels; {populates the array of pixels}
Add(aEllROI);
end;
function TROIList.GetROIs(roiIndex: integer): TSimpleROI;
begin
Result := TSimpleROI(Items[roiIndex]);
end;
function TROIList.PtInObject(aPt: TPoint): TObjectROI;
var i: integer;
begin
Result := nil;
if Count> 0 then
for i := 0 to Count - 1 do
if ROIs[i] is TObjectROI then
if ROIs[i].PtInROI(aPt) then
Result := TObjectROI(ROIs[i]);
end;
function TROIList.ROIOfPt(chIndex: integer; aPt: TPoint): integer;
var i: integer;
begin
Result := -1; i := 0;
while (i < Count) and (Result = -1) do
begin
if (ROIs[i].fchannel = chIndex) and ROIs[i].PtInROI(aPt) then
Result := i
else
i := i + 1;
end;
end;
procedure TROIList.Clear;
var i: integer;
begin
if Count > 0 then
for i := 0 to Count - 1 do
ROIs[i].Free;
inherited Clear;
end;
destructor TROIList.Destroy;
begin
Clear;
Inherited Destroy;
end;
function FindCommonRegion(start1, end1, start2, end2: integer;
var commonStart, commonEnd: integer): boolean;
begin
{make sure that end1 <= start1}
if start1 > end1 then
begin
commonStart := start1;
start1 := end1;
end1 := commonStart;
end;
if start2 > end2 then
begin
commonStart := start2;
start2 := end2;
end2 := commonStart;
end;
if start1 > start2 then
begin
commonStart := start1;
commonEnd := end1;
// start1 := start2; no need
end1 := end2;
start2 := commonStart;
end2 := commonEnd;
end;
if start2 > end1 then
Result := False
else
begin
commonStart := start2;
if end2 <= end1 then
commonEnd := end2
else
commonEnd := end1;
Result := True;
end;
end;
procedure NormalizeRect(var rect: TRect);
var i: integer;
begin
if rect.Left > rect.Right then
begin
i := rect.Left;
rect.Left := rect.Right;
rect.Right := i;
end;
if rect.Top > rect.Bottom then
begin
i := rect.Top;
rect.Top := rect.Bottom;
rect.Bottom := i;
end;
end;
function StgErrToFileErr(hr: HResult): TFileErr;
begin
{if integer(hr) = STG_E_INVALIDFUNCTION then
else} if integer(hr) = STG_E_FILENOTFOUND then
Result := feCannotFindFile
else if integer(hr) = STG_E_PATHNOTFOUND then
Result := fePathNotFound
else if integer(hr) = STG_E_TOOMANYOPENFILES then
Result := feTooManyFilesOpened
else if integer(hr) = STG_E_ACCESSDENIED then
Result := feAccessDenied
{ else if integer(hr) = STG_E_INVALIDHANDLE then
Result := ;}
else if integer(hr) = STG_E_INSUFFICIENTMEMORY then
Result := feOutOfMemory
else if integer(hr) = STG_E_INVALIDPOINTER then
Result := feBadData
{ else if integer(hr) = STG_E_NOMOREFILES then
Result := ;}
else if integer(hr) = STG_E_DISKISWRITEPROTECTED then
Result := feCannotReadFile
else if integer(hr) = STG_E_SEEKERROR then
Result := feCannotReadFile
else if integer(hr) = STG_E_WRITEFAULT then
Result := feUnexpectedEOF
else if integer(hr) = STG_E_READFAULT then
Result := feCannotReadFile
else if integer(hr) = STG_E_SHAREVIOLATION then
Result := feShareViolation
{ else if integer(hr) = STG_E_LOCKVIOLATION then
Result := ;
else if integer(hr) = STG_E_FILEALREADYEXISTS then
Result := ;
else if integer(hr) = STG_E_INVALIDPARAMETER then
Result := ;}
else if integer(hr) = STG_E_MEDIUMFULL then
Result := feDiskFull
{ else if integer(hr) = STG_E_ABNORMALAPIEXIT then
Result := ;
else if integer(hr) = STG_E_INVALIDHEADER then
Result := ;}
else if integer(hr) = STG_E_INVALIDNAME then
Result := feInvalidName
else if integer(hr) = STG_E_UNKNOWN then
Result := feUnknownError
{ else if integer(hr) = STG_E_UNIMPLEMENTEDFUNCTION then
Result := ;
else if integer(hr) = STG_E_INVALIDFLAG then
Result := ;}
else
Result := feUnknownError;
end;
function PointStrictlyInRect(const aPt: TPoint; aRect: TRect): boolean;
begin
NormalizeRect(aRect);
if (aPt.X >= aRect.Left) and (aPt.X <= aRect.Right) and
(aPt.Y >= aRect.Top) and (aPt.Y <= aRect.Bottom) then
Result := True
else
Result := False;
end;
end.
Raw
Viewer
unit vieweru;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Menus, ImgList, ToolWin, ComCtrls, ExtCtrls, mpviewu, mpfileu;
type
TMouseAction = (maNormal, maRectangularROI, maEllipticROI, maLineProfile, maStats);
TViewerFrm = class(TForm)
StatusBar1: TStatusBar;
ImageList1: TImageList;
MainMenu1: TMainMenu;
Frame1: TMenuItem;
NextFrame1: TMenuItem;
PrevFrame1: TMenuItem;
N1: TMenuItem;
FastForward1: TMenuItem;
FastReverse1: TMenuItem;
N2: TMenuItem;
FirstFrame1: TMenuItem;
LastFrame1: TMenuItem;
GotoFrame1: TMenuItem;
ROI1: TMenuItem;
Zoom1: TMenuItem;
Increasezoom1: TMenuItem;
DecreaseZoom1: TMenuItem;
Grayscale1: TMenuItem;
FalseColors1: TMenuItem;
N3: TMenuItem;
CreateProjection1: TMenuItem;
CopyFrames1: TMenuItem;
Stop1: TMenuItem;
Panel1: TPanel;
ToolBar1: TToolBar;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
ToolButton3: TToolButton;
ToolButton4: TToolButton;
ToolButton5: TToolButton;
ToolButton6: TToolButton;
ToolButton7: TToolButton;
ToolButton8: TToolButton;
SaveFrameasBitmap1: TMenuItem;
MakeAVIMovie1: TMenuItem;
N5: TMenuItem;
SubtractwithFrame1: TMenuItem;
N6: TMenuItem;
Comments1: TMenuItem;
N7: TMenuItem;
NewFrameViewer1: TMenuItem;
CopyFrames2: TMenuItem;
N8: TMenuItem;
SaveDialog1: TSaveDialog;
GammaCorrection1: TMenuItem;
N9: TMenuItem;
AverageFrames1: TMenuItem;
ProjectFrameonYaxis1: TMenuItem;
ProjectFramesonXaxis1: TMenuItem;
Objects1: TMenuItem;
FindObjects1: TMenuItem;
DeleteallObjects1: TMenuItem;
PlotROIofObjects1: TMenuItem;
CreateRectangularROI1: TMenuItem;
CreateEllipticalROI1: TMenuItem;
HideROIs1: TMenuItem;
N4: TMenuItem;
N10: TMenuItem;
N11: TMenuItem;
CreateLineProfile1: TMenuItem;
ToolButton9: TToolButton;
AutomaticBackgroundCorrection1: TMenuItem;
AreaStats1: TMenuItem;
ExportFramesasamultipageTIFFfile1: TMenuItem;
PaintBox1: TPaintBox;
CustomColors1: TMenuItem;
N12: TMenuItem;
CustomColorsLookupTable1: TMenuItem;
N13: TMenuItem;
BinaryFrameOperations1: TMenuItem;
N14: TMenuItem;
OverlayCh1onCh21: TMenuItem;
OverlayCh2onCh31: TMenuItem;
procedure FormActivate(Sender: TObject);
procedure FormDeactivate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure ToolButton2Click(Sender: TObject);
procedure ToolButton4Click(Sender: TObject);
procedure ToolButton3Click(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure ToolButton5Click(Sender: TObject);
procedure FirstFrame1Click(Sender: TObject);
procedure LastFrame1Click(Sender: TObject);
procedure GotoFrame1Click(Sender: TObject);
procedure Comments1Click(Sender: TObject);
procedure Grayscale1Click(Sender: TObject);
procedure Increasezoom1Click(Sender: TObject);
procedure DecreaseZoom1Click(Sender: TObject);
procedure NewFrameViewer1Click(Sender: TObject);
procedure SaveFrameasBitmap1Click(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Gammacorrection1Click(Sender: TObject);
procedure CopyFrames2Click(Sender: TObject);
procedure AverageFrames1Click(Sender: TObject);
procedure CreateProjection1Click(Sender: TObject);
procedure ProjectFrameonYaxis1Click(Sender: TObject);
procedure ProjectFramesonXaxis1Click(Sender: TObject);
procedure SubtractwithFrame1Click(Sender: TObject);
procedure DeleteallROIs1Click(Sender: TObject);
procedure MakeAVIMovie1Click(Sender: TObject);
procedure DeleteallObjects1Click(Sender: TObject);
procedure HideROIs1Click(Sender: TObject);
procedure CreateRectangularROI1Click(Sender: TObject);
procedure CreateEllipticalROI1Click(Sender: TObject);
procedure FindObjects1Click(Sender: TObject);
procedure PlotROIofObjects1Click(Sender: TObject);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormDblClick(Sender: TObject);
procedure CreateLineProfile1Click(Sender: TObject);
procedure CopyFrames1Click(Sender: TObject);
procedure AutomaticBackgroundCorrection1Click(Sender: TObject);
procedure AreaStats1Click(Sender: TObject);
procedure ExportFramesasamultipageTIFFfile1Click(Sender: TObject);
procedure CustomColors1Click(Sender: TObject);
procedure FalseColors1Click(Sender: TObject);
procedure CustomColorsLookupTable1Click(Sender: TObject);
procedure PaintBox1Paint(Sender: TObject);
procedure BinaryFrameOperations1Click(Sender: TObject);
procedure OverlayCh1onCh21Click(Sender: TObject);
procedure OverlayCh2onCh31Click(Sender: TObject);
private
{ Private declarations }
roiPt: TPoint;
colorScheme: TColorScheme;
chRect, bitmapChRect: array[0..MAX_CH - 1] of TRect;
frameBitmap: TBitmap;
fCurrentFrameIndex: integer;
fZoomIndex: integer;
currentChannel, anchorX, anchorY, prevX, prevY: integer;
mouseAction: TMouseAction;
ROIList: TROIList;
procedure AdjustWindowSize;
function CheckNoFrame: boolean;
procedure DrawFrame;
procedure GetChRect;
procedure ExportToMatlab(chIndex, fromFrame, toFrame: integer;
frameName: string; startingIndex: integer; workspace: string);
procedure MakeColorScale;
procedure OnNewFrame;
procedure SelectROIPlot(bAllROIs: boolean; roiIndex: integer);
procedure SetLUTColors;
procedure PlotLineProfile(chIndex: integer; rc: TRect);
procedure PlotROI(roiIndex, fromFrame, toFrame: integer);
procedure SetCurrentFrameIndex(newIndex: integer);
function WindowToChannel(X, Y: integer; var retChannel: integer): boolean;
function WindowToFrameX(chIndex, xVal: integer): integer;
function WindowToFrameY(yVal: integer): integer;
public
{ Public declarations }
mpFile: TMPFile;
procedure Initialize(thempFile: TMPFile; viewerIndex: integer);
property CurrentFrameIndex: integer read fCurrentFrameIndex write SetCurrentFrameIndex;
end;
var
ViewerFrm: TViewerFrm;
implementation
{$R *.DFM}
uses Mainfrm, gammafrmu, opframedlgu, DetectROIDlgu, PlotROIDlgu,
AVIOptDlgu, ROIFrmu, mtransferdlgu, ActiveX, StatDlgu, lutdlgu, binfrm
{, Variants};
{-------------------------------- PRIVATE -------------------------------------}
procedure TViewerFrm.AdjustWindowSize;
var newWidth, newHeight: integer;
begin
if mpFile = nil then Exit;
{just in case width and height suddenly changed as caused by mpFile.StackX or mpFile.StackY}
newWidth := mpFile.VideoChCount * mpFile.FrameWidth + mpFile.VideoChCount - 1;
newHeight := mpFile.FrameHeight;
if (frameBitmap.Width <> newWidth) or (frameBitmap.Height <> newHeight) then
begin
frameBitmap.Width := newWidth;
frameBitmap.Height := newHeight;
end;
GetChRect;
if chRect[MAX_CH - 1].Right - chRect[0].Left + PaintBox1.Width + 1 > 500 then
ClientWidth := chRect[MAX_CH - 1].Right - chRect[0].Left + PaintBox1.Width + 1
else
ClientWidth := 500;
if Panel1.Height + StatusBar1.Height + fZoomIndex * mpFile.FrameHeight > 500 then
ClientHeight := Panel1.Height + StatusBar1.Height + fZoomIndex * mpFile.FrameHeight
else
ClientHeight := 500;
end;
function TViewerFrm.CheckNoFrame: boolean;
begin
if (mpFile = nil) or (mpFile.FrameCount = 0) then
begin
Result := True;
MessageDlg( 'Operation not possible.' + CRLF +
'Workspace has no frame.', mtInformation, [mbOK], 0);
end
else
Result := False;
end;
type TBitmapLine = array[0..Maxint div 8] of TRGBTriple;
TpBitmapLine = ^TBitmapLine;
procedure TViewerFrm.DrawFrame;
var i, j, k, l, m, pixelValue, pixelXOffset, maxPixValue: integer;
pLine : TpBitmapLine;
pixel0, pixel1: TRGBTriple;
const RGB_GREEN: TRGBTriple = (rgbtBlue: 0; rgbtGreen: 255; rgbtRed: 0);
RGB_BLACK: TRGBTriple = (rgbtBlue: 0; rgbtGreen: 255; rgbtRed: 0);
begin
{separation line between channels}
with mpFile, frameBitmap, frameBitmap.Canvas do
if VideoChCount > 1 then
begin
Brush.Color := clBlack;
FillRect(Rect(0,0,frameBitmap.Width - 1, frameBitmap.Height - 1));
Pen.Width := 1;
if colorScheme = CS_GRAYSCALE then Pen.Color := clOlive else Pen.Color := clRed;
Pen.Style := psSolid;
Pen.Mode := pmCopy;
for i := 1 to VideoChCount - 1 do
begin
MoveTo(i * (FrameWidth + 1) - 1, 0);
LineTo(i * (FrameWidth + 1) - 1, FrameHeight - 1);
end;
end;
with mpFile do
for m := 0 to MAX_CH - 1 do
if VideoChEnabled[m] then
begin
maxPixValue := ChMaxPixelValues[m];
pixelXOffset := bitmapChRect[m].Left;
for i := 0 to FrameHeight - 1 do
begin
pLine := frameBitmap.ScanLine[i];
for j := 0 to FrameWidth - 1 do
begin
k := j + i * FrameWidth; {index in frame data buffer for Ch1}
l := j + pixelXOffset;
pixelValue := Frames[CurrentFrameIndex].Channels[m].data[k];
{Maps pixel value to 0..MAX_FALSE_COLORS - 1}
pixelValue := Muldiv(pixelValue, MAX_FALSE_COLORS - 1, MaxPixValue);
if pixelValue < 0 then pixelValue := 0;
if pixelValue > MAX_FALSE_COLORS - 1 then pixelValue := MAX_FALSE_COLORS - 1;
if colorScheme = CS_FALSECOLORS then
pLine^[l] := Mainform.falseColorTable[pixelValue]
else if colorScheme = CS_GRAYSCALE then
pLine^[l] := Mainform.grayScaleTable[pixelValue]
else
pLine^[l] := CustomColors[m][pixelValue];
{Overlay Ch1 on Ch2}
if OverlayCh1onCh21.Checked and (m = 1) and (VideoChEnabled[0]) then
begin
pixel1 := pLine^[l];
pixel0 := pLine^[l - pixelXOffset];
pixel1.rgbtBlue := pixel1.rgbtBlue or pixel0.rgbtBlue;
pixel1.rgbtGreen := pixel1.rgbtGreen or pixel0.rgbtGreen;
pixel1.rgbtRed := pixel1.rgbtRed or pixel0.rgbtRed;
pLine^[l] := pixel1;
end;
{Overlay Ch2 on Ch3}
if OverlayCh2onCh31.Checked and (m = 2) and (VideoChEnabled[1]) then
begin
pixel1 := pLine^[l];
pixel0 := pLine^[l - pixelXOffset];
pixel1.rgbtBlue := pixel1.rgbtBlue or pixel0.rgbtBlue;
pixel1.rgbtGreen := pixel1.rgbtGreen or pixel0.rgbtGreen;
pixel1.rgbtRed := pixel1.rgbtRed or pixel0.rgbtRed;
pLine^[l] := pixel1;
end;
end; {for j}
end; {for i}
end; {end VideoChEnabled[m]}
if not HideROIs1.Checked then
if ROIList.Count > 0 then
for i := 0 to ROIList.Count - 1 do
with ROIList.ROIs[i] do
Draw(frameBitmap, bitmapChRect[Channel].Left);
Canvas.CopyRect(Rect(chRect[0].Left, chRect[0].Top, chRect[MAX_CH-1].Right, chRect[MAX_CH - 1].Bottom),
frameBitmap.Canvas, Rect(0, 0, frameBitmap.Width - 1, frameBitmap.Height - 1));
end;
type
TVT8Array = array[0..Maxint div 16] of double;
TpVT8Array = ^TVT8Array;
procedure TViewerFrm.ExportToMatlab(chIndex, fromFrame, toFrame: integer;
frameName: string; startingIndex: integer; workspace: string);
var i, j, k, l: integer;
fullFrameName: string;
pArray: TpVT8Array;
frameArray, imaginaryArray: Variant;
begin
try
Screen.Cursor := crHourGlass;
if VarIsEmpty(Mainform.matlab) then MainForm.Options1Click(nil);
if not VarIsEmpty(Mainform.matlab) then
begin
frameArray := VarArrayCreate([0, mpFile.FrameHeight - 1, 0, mpFile.FrameWidth - 1],
varDouble);
imaginaryArray := Unassigned;
TVarData(imaginaryArray).VType := varDouble or varArray;
TVarData(imaginaryArray).VArray := nil;
for i := fromFrame to toFrame do
begin
if fromFrame = toFrame then
fullFrameName := frameName
else
fullFrameName := frameName + '_' + IntToStr(startingIndex + i - fromFrame);
pArray := VarArrayLock(frameArray);
for j := 0 to mpFile.FrameHeight - 1 do
for k := 0 to mpFile.FrameWidth - 1 do
begin
l := k + j * mpFile.FrameWidth;
pArray^[l] := mpFile.Frames[i].Channels[chIndex].data[l];
end;
VarArrayUnlock(frameArray);
Mainform.matlab.PutFullMatrix(fullFrameName, workspace,
VarArrayRef(frameArray), VarArrayRef(imaginaryArray));
end;
end;
finally
Screen.Cursor := crDefault;
end;
end;
procedure TViewerFrm.GetChRect;
var l, r, t, b, zl,zr, zt, zb, curCh, i: integer;
begin
with mpFile do
begin
l := 0;
r := 0;
t := 0;
b := FrameHeight - 1;
zl := 0;
zr := zl;
zt := Panel1.Height + 1;
zb := zt + fzoomIndex * FrameHeight - 1;
curCh := 0;
for i := 0 to MAX_CH - 1 do
begin
if VideoChEnabled[i] then
begin
{Let's have a border of 1 pixel * zoom if there more than two channels}
if (curCh > 0) then
begin
l := r + 2 {border};
zl := zr + 1 + fzoomIndex;
end;
r := l + FrameWidth - 1;
zr := zl + fzoomIndex * FrameWidth - 1;
curCh := curCh + 1;
end;
bitmapChRect[i] := Rect(l, t, r, b);
chRect[i] := Rect(zl, zt, zr, zb);
end;
end;
end;
procedure TViewerFrm.MakeColorScale;
var firstX, lastX, firstY, lastY, i, j, validCh,
beginstripe, endstripe: integer;
curColor: TColor;
rgbTriple: TRGBTriple;
begin
with PaintBox1, PaintBox1.Canvas do
begin
Brush.Color := clBlack;
FillRect(ClientRect);
firstX := ClientRect.Left + 2;
lastX := ClientRect.Right - 2;
firstY := ClientRect.Top + 2;
lastY := ClientRect.Bottom - 2;
if GrayScale1.Checked then
for i := firstY to LastY do
begin
curColor := Muldiv(255, i - LastY, firstY - LastY);
if i = firstY then Pen.Color := RGB(255, 0, 0) else
if i = (lastY - firstY) div 2 + firstY then Pen.Color := RGB(0, 0, 255) else
Pen.Color := RGB(curColor, curColor, curColor);
MoveTo(firstX, i);
LineTo(lastX, i);
end
else if FalseColors1.Checked then
for i := firstY to LastY do
begin
rgbTriple := Mainform.falseColorTable[Muldiv(MAX_FALSE_COLORS -1, i - LastY, firstY - LastY)];
Pen.Color := RGB(rgbTriple.rgbtRed, rgbTriple.rgbtGreen, rgbTriple.rgbtBlue);
MoveTo(firstX, i);
LineTo(lastX, i);
end
else {custom LUT}
with mpFile do
begin
validCh := 0;
for j := 0 to MAX_CH - 1 do
if VideoChEnabled[j] then
begin
beginstripe := firstX + Muldiv(validCh, lastX - firstX, VideoChCount);
endstripe := firstX + Muldiv(validCh + 1, lastX - firstX, VideoChCount);
for i := firstY to LastY do
begin
rgbTriple := CustomColors[j,
Muldiv(MAX_FALSE_COLORS - 1, i - LastY, firstY - LastY)];
Pen.Color := RGB(rgbTriple.rgbtRed, rgbTriple.rgbtGreen, rgbTriple.rgbtBlue);
MoveTo(beginstripe, i);
LineTo(endstripe, i);
end;
validCh := validCh + 1;
end;
end;
end; {with begin}
end;
procedure TViewerFrm.OnNewFrame;
begin
AdjustWindowSize;
if AutomaticBackgroundCorrection1.Checked then mpFile.DoBackgroundCorrection;
DrawFrame;
StatusBar1.Panels[0].Text := 'Frame ' + IntToStr(CurrentFrameIndex + 1) + '/'
+ IntToStr(mpFile.FrameCount);
StatusBar1.Panels[6].Text := mpFile.FrameComment[CurrentFrameIndex];
end;
procedure TViewerFrm.SelectROIPlot(bAllROIs: boolean; roiIndex: integer);
var i, fromFrame, toFrame: integer;
begin
if ROIList.Count > 0 then
begin
with PlotROIDlg do
begin
ComboBox1.Clear;
for i := 0 to ROIList.Count - 1 do
ComboBox1.Items.Add(IntToStr(i + 1));
if bAllROIs then
begin
ComboBox1.Enabled := True;
ComboBox1.ItemIndex := 0;
end
else
begin
ComboBox1.ItemIndex := roiIndex;
ComboBox1.Enabled := False;
end;
SpinEdit1.MinValue := 1;
SpinEdit1.MaxValue := mpFile.FrameCount;
SpinEdit1.Value := 1;
SpinEdit2.MinValue := mpFile.FrameCount;
SpinEdit2.MaxValue := mpFile.FrameCount;
SpinEdit2.Value := mpFile.FrameCount;
if PlotROIDlg.ShowModal = mrOK then
begin
fromFrame := SpinEdit1.Value - 1;
toFrame := SpinEdit2.Value - 1;
if (fromFrame >= 0) and (fromFrame < mpFile.FrameCount) and
(toFrame >= 0) and (toFrame < mpFile.FrameCount) and
(toFrame >= fromFrame) then
begin
if (fromFrame <> toFrame) then
PlotROI(ComboBox1.ItemIndex, fromFrame, toFrame)
else
MessageDlg('Average ROI value = ' +
IntToStr(mpFile.GetROIAverageValue(ROIList, ComboBox1.ItemIndex, toFrame)),
mtInformation, [mbOK], 0);
end
else
MessageDlg('Invalid parameters', mtError, [mbOK], 0);
end;
end;
end;
end;
procedure TViewerFrm.PlotROI(roiIndex, fromFrame, toFrame: integer);
var aROIFrm: TROIFrm;
i: integer;
begin
try
Screen.Cursor := crHourGlass;
aROIFrm := TROIFrm.Create(Mainform);
aROIFrm.FrameRate := mpFile.FrameRate;
aROIFrm.FromFrame := fromFrame;
aROIFrm.ToFrame := toFrame;
aROIFrm.dataSize := toFrame - fromFrame + 1;
aROIFrm.Caption := Caption + '- ROI: ' + IntToStr(roiIndex + 1);
for i := fromFrame to toFrame do
aROIFrm.dataBuffer[i - fromFrame] := mpFile.GetROIAverageValue(ROIList, roiIndex, i);
aROIFrm.Show;
aROIFrm.FormResize(nil); {forces repainting}
finally
Screen.Cursor := crDefault;
end;
end;
procedure TViewerFrm.PlotLineProfile(chIndex: integer; rc: TRect);
var aROIFrm: TROIFrm;
i, j, x, y: integer;
bPlotX: boolean;
firstPt, lastPt: integer;
begin
bPlotX := (Abs(rc.Right - rc.Left) >= Abs(rc.Bottom - rc.Top));
if (bPlotX and (rc.Left > rc.Right)) or (not bPlotX and (rc.Top > rc.Bottom)) then
begin
i := rc.Top;
rc.Top := rc.Bottom;
rc.Bottom := i;
i := rc.Left;
rc.Left := rc.Right;
rc.Right := i;
end;
if (Abs(rc.Right - rc.Left) < 10) and (Abs(rc.Bottom - rc.Top) < 10) then
MessageDlg('Too few points for a profile', mtError, [mbOK], 0)
else
begin
if bPlotX then
begin
firstPt := rc.Left;
lastPt := rc.Right;
end
else
begin
firstPt := rc.Top;
lastPt := rc.Bottom;
end;
aROIFrm := TROIFrm.Create(Mainform);
aROIFrm.bLineProfile := True; {turns off automatic X- axis caption}
aROIFrm.FromFrame := firstPt;
aROIFrm.ToFrame := lastPt;
aROIFrm.dataSize := lastPt - firstPt + 1;
aROIFrm.Caption := Caption + '- Line Profile: ' +
'(' + IntToStr(rc.Left) + ', ' + IntToStr(rc.Top) + ') to (' +
IntToStr(rc.Right) +', ' + IntToStr(rc.Bottom) + ')';
for i := firstPt to lastPt do
begin
if bPlotX then
begin
x := i;
y := rc.Top + Muldiv(i - firstPt, rc.Bottom - rc.Top, lastPt - firstPt);
end
else
begin
y := i;
x := rc.Left + Muldiv(i - firstPt, rc.Right - rc.Left, lastPt - firstPt);
end;
j := x + y * mpFile.FrameWidth;
aROIFrm.dataBuffer[i - firstPt] :=
mpFile.Frames[CurrentFrameIndex].Channels[chIndex].data[j];
end;
aROIFrm.Show;
aROIFrm.FormResize(nil); {forces repainting}
end;
end;
procedure TViewerFrm.SetCurrentFrameIndex(newIndex: integer);
begin
if (newIndex < 0) or (newIndex >= mpFile.FrameCount) then Exit;
fCurrentFrameIndex := newIndex;
mpFile.ActiveFrameIndex := fCurrentFrameIndex;
OnNewFrame;
end;
procedure TViewerFrm.SetLUTColors;
var i, j, rval, gval, bval: integer;
begin
with mpFile do
for j := 0 to MAX_CH - 1 do
begin
if baseColors[j, 0] then rval := 255 else rval := 0;
if baseColors[j, 1] then gval := 255 else gval := 0;
if baseColors[j, 2] then bval := 255 else bval := 0;
for i := 0 to MaxPixels[j] - 1 do
begin
CustomColors[j, i].rgbtBlue := Muldiv(bval, i, MaxPixels[j] - 1);
CustomColors[j, i].rgbtGreen := Muldiv(gval, i, MaxPixels[j] - 1);
CustomColors[j, i].rgbtRed := Muldiv(rval, i, MaxPixels[j] - 1);
end;
CustomColors[j, 1023] := midRangeColors[j];
for i := MaxPixels[j] to MAX_FALSE_COLORS - 1 do
CustomColors[j, i] := maxColors[j];
end;
end;
function TViewerFrm.WindowToChannel(X, Y: integer; var retChannel: integer): boolean;
begin
Result := True;
with mpFile do
if PointStrictlyInRect(Point(X, Y), ChRect[0]) and VideoChEnabled[0] then
retChannel := 0
else if PointStrictlyInRect(Point(X, Y), ChRect[1]) and VideoChEnabled[1] then
retChannel := 1
else if PointStrictlyInRect(Point(X, Y), ChRect[2]) and VideoChEnabled[2] then
retChannel := 2
else if PointStrictlyInRect(Point(X, Y), ChRect[3]) and VideoChEnabled[3] then
retChannel := 3
else
Result := False;
end;
function TViewerFrm.WindowToFrameX(chIndex, xVal: integer): integer;
begin
Result := (xVal - chRect[chIndex].Left) div fZoomIndex;
end;
function TViewerFrm.WindowToFrameY(yVal: integer): integer;
begin
Result := (yVal - chRect[0].Top) div fZoomIndex;
end;
{--------------------------------- PUBLIC -------------------------------------}
procedure TViewerFrm.Initialize(thempFile: TMPFile; viewerIndex: integer);
begin
mpFile := thempFile;
SetLUTColors;
frameBitmap.Width := mpFile.VideoChCount * mpFile.FrameWidth + mpFile.VideoChCount - 1;
frameBitmap.Height := mpFile.FrameHeight;
fZoomIndex := 1;
fCurrentFrameIndex := 0;
Caption := ExtractFileName(mpFile.Filename) + ' <- Viewer ' + IntToStr(viewerIndex);
AdjustWindowSize;
with mpfile do
OverlayCh2onCh31.Enabled :=
ChEnabled[1] and ChEnabled[2] and VideoChEnabled[2];
end;
{-------------------- CONSTRUCTION - DESTRUCTION ------------------------------}
procedure TViewerFrm.FormCreate(Sender: TObject);
begin
frameBitmap := TBitmap.Create;
frameBitmap.HandleType := bmDIB;
frameBitmap.PixelFormat := pf24bit;
ROIList := TROIList.Create;
PrevFrame1.ShortCut := ShortCut(VK_LEFT, []);
NextFrame1.ShortCut := ShortCut(VK_RIGHT, []);
end;
procedure TViewerFrm.FormActivate(Sender: TObject);
begin
with Mainform do
begin
NewFile1.Enabled := True;
OpenFile1.Enabled := True;
if mpFile <> nil then
FileAs1.Enabled := mpFile.IsMemoryFile
else
FileAs1.Enabled := False;
FileInformation1.Enabled := True;
Close1.Enabled := True;
end;
end;
procedure TViewerFrm.FormDeactivate(Sender: TObject);
begin
with Mainform do
begin
NewFile1.Enabled := False;
OpenFile1.Enabled := False;
FileAs1.Enabled := False;
FileInformation1.Enabled := False;
Close1.Enabled := False;
end;
end;
procedure TViewerFrm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
action := caFree;
FreeAndNil(frameBitmap);
if (mpFile <> nil) and (not Mainform.bAppClosing) then mpFile.OnWndClose(self);
mpFile := nil;
end;
procedure TViewerFrm.FormDestroy(Sender: TObject);
begin
{ frameBitmap.Free;}
ROIList.Free;
end;
{---------------------------------- EVENTS ------------------------------------}
procedure TViewerFrm.ToolButton2Click(Sender: TObject);
begin
CurrentFrameIndex := CurrentFrameIndex - 1;
end;
procedure TViewerFrm.ToolButton4Click(Sender: TObject);
begin
CurrentFrameIndex := CurrentFrameIndex + 1;
end;
procedure TViewerFrm.ToolButton3Click(Sender: TObject);
begin
ToolButton1.Down := False;
ToolButton5.Down := False;
end;
procedure TViewerFrm.ToolButton1Click(Sender: TObject);
begin
while (CurrentFrameIndex > 0) and (ToolButton1.Down) do
begin
CurrentFrameIndex := CurrentFrameIndex - 1;
Application.ProcessMessages;
end;
ToolButton1.Down := False;
end;
procedure TViewerFrm.ToolButton5Click(Sender: TObject);
begin
while (CurrentFrameIndex < mpFile.FrameCount - 1) and (ToolButton5.Down) do
begin
CurrentFrameIndex := CurrentFrameIndex + 1;
Application.ProcessMessages;
end;
ToolButton5.Down := False;
end;
procedure TViewerFrm.FirstFrame1Click(Sender: TObject);
begin
CurrentFrameIndex := 0;
end;
procedure TViewerFrm.LastFrame1Click(Sender: TObject);
begin
CurrentFrameIndex := mpFile.FrameCount - 1;
end;
procedure TViewerFrm.GotoFrame1Click(Sender: TObject);
var sFrameIndex: string;
iFrameIndex: integer;
begin
if (mpFile = nil) or (mpFile.FrameCount = 0) then Exit;
sFrameIndex := '1';
if InputQuery('Go to Frame', 'Enter Frame Index', sFrameIndex) then
begin
iFrameIndex := StrToInt(sFrameIndex);
if (iFrameIndex < 1) or (iFrameIndex > mpFile.FrameCount) then
MessageDlg('Invalid Frame Index.', mtError, [mbOK], 0)
else
CurrentFrameIndex := iFrameIndex - 1;
end;
end;
procedure TViewerFrm.Comments1Click(Sender: TObject);
var sFrameComment: string;
begin
if (mpFile = nil) or (mpFile.FrameCount = 0) then Exit;
sFrameComment := mpFile.FrameComment[CurrentFrameIndex];
if InputQuery('Frame Comment', 'Enter Frame Comment', sFrameComment) then
begin
mpFile.FrameComment[CurrentFrameIndex] := sFrameComment;
StatusBar1.Panels[6].Text := sFrameComment;
end;
end;
procedure TViewerFrm.Grayscale1Click(Sender: TObject);
begin
if Grayscale1.Checked then Exit;
Grayscale1.Checked := True;
colorScheme := CS_GRAYSCALE;
FalseColors1.Checked := False;
CustomColors1.Checked := False;
MakeColorScale;
DrawFrame;
end;
procedure TViewerFrm.Increasezoom1Click(Sender: TObject);
begin
if fZoomIndex < 5 then
begin
fZoomIndex := fZoomIndex + 1;
AdjustWindowSize;
DrawFrame;
end;
end;
procedure TViewerFrm.DecreaseZoom1Click(Sender: TObject);
begin
if fZoomIndex > 1 then
begin
fZoomIndex := fZoomIndex - 1;
AdjustWindowSize;
DrawFrame;
end;
end;
procedure TViewerFrm.NewFrameViewer1Click(Sender: TObject);
begin
mpFile.NewViewer;
end;
procedure TViewerFrm.SaveFrameasBitmap1Click(Sender: TObject);
begin
if CheckNoFrame then Exit;
with SaveDialog1 do
begin
DefaultExt := 'BMP';
Filter := 'Bitmaps (*.BMP)|*.BMP|All Files (*.*)|*.*';
InitialDir := ExtractFilePath(mpFile.Filename);
Title := 'Save Frame as Bitmap';
if Execute then frameBitmap.SaveToFile(Filename);
end;
end;
procedure TViewerFrm.FormPaint(Sender: TObject);
begin
if frameBitmap = nil then Exit;
with Canvas do
begin
Brush.Color := clOlive;
FillRect(ClientRect);
end;
Canvas.CopyRect(Rect(chRect[0].Left, chRect[0].Top, chRect[MAX_CH - 1].Right, chRect[MAX_CH - 1].Bottom),
frameBitmap.Canvas, Rect(0, 0, frameBitmap.Width - 1, frameBitmap.Height - 1));
end;
procedure TViewerFrm.Gammacorrection1Click(Sender: TObject);
var blackLevel, whiteLevel, i, chIndex: integer;
begin
if CheckNoFrame then Exit;
mpFile.ActiveFrameIndex := CurrentFrameIndex;
GammaFrm.bInitializing := True;
GammaFrm.mpFile := mpFile;
GammaFrm.InitGUI(mpFile);
GammaFrm.CheckBox1.Checked := False;
GammaFrm.CheckBox1.Enabled := mpFile.IsMemoryFile;
GammaFrm.TrackBar1.Position := 128; {default black level = 0}
GammaFrm.TrackBar2.Position := 2047 + 128; {default black level = 0}
GammaFrm.Label1.Caption := 'Black Level = 0';
GammaFrm.Label2.Caption := 'White Level = 2047';
GammaFrm.bInitializing := False;
if GammaFrm.ShowModal = mrOK then
begin
blackLevel := GammaFrm.TrackBar1.Position - 128;
whiteLevel := GammaFrm.TrackBar2.Position - 128;
if blackLevel >= whiteLevel then
MessageDlg('Black Level must be smaller than White Level.', mtError,
[mbOK], 0)
else
begin
chIndex := GammaFrm.SelectedCh;
if whiteLevel > mpFile.ChMaxPixelValues[chIndex] then
begin
MessageDlg('Adjusted White Level to maximal possible pixel value.',
mtWarning, [mbOK], 0);
whiteLevel := mpFile.ChMaxPixelValues[chIndex];
end;
if GammaFrm.CheckBox1.Checked then
for i := 0 to mpFile.FrameCount - 1 do
(mpFile.Frames[i].channels[chIndex] as TVideoFrame).
GammaCorrection(blackLevel, whiteLevel)
else
(mpFile.Frames[CurrentFrameIndex].channels[chIndex] as TVideoFrame).
GammaCorrection(blackLevel, whiteLevel);
OnNewFrame;
end;
end;
end;
procedure TViewerFrm.AverageFrames1Click(Sender: TObject);
var fromFrame, toFrame, repeatCount, lastFrame, chIndex, i: integer;
oldCursor: TCursor;
destMPFile: TMPFile;
begin
if CheckNoFrame then Exit;
if Mainform.fileList.WorkspaceCount = 0 then
MessageDlg('No workspace for this operation.' + CRLF +
'Create a workspace file first.', mtInformation, [mbOK], 0)
else
begin
with opframedlg do
begin
Caption := 'Average Frames';
opframedlg.InitGUI(mpFile);
Mainform.fileList.
FillComboBoxWithWorkspaces(ComboBox1);
ComboBox1.ItemIndex := 0;
Label1.Caption := 'From Frame';
Label3.Caption := 'To Frame';
SpinEdit1.MinValue := 1;
SpinEdit2.MinValue := 1;
SpinEdit1.MaxValue := mpFile.FrameCount;
SpinEdit2.MaxValue := mpFile.FrameCount;
SpinEdit1.Value := CurrentFrameIndex + 1;
SpinEdit2.Value := CurrentFrameIndex + 1;
Label4.Visible := True;
Label4.Caption := 'Repeat';
SpinEdit3.MinValue := 1;
SpinEdit3.MaxValue := mpFile.FrameCount;
SpinEdit3.Value := 1;
SpinEdit3.Visible := True;
Label5.Visible := False;
SpinEdit4.Visible := False;
end;
if opframedlg.ShowModal = mrOK then
begin
fromFrame := opframedlg.SpinEdit1.Value - 1;
toFrame := opframedlg.SpinEdit2.Value - 1;
repeatCount := opframedlg.SpinEdit3.Value;
chIndex := opframedlg.SelectedCh;
if (fromFrame <= toFrame) and (fromFrame >= 0) and (fromFrame
< mpFile.FrameCount) and (toFrame >= 0) and (toFrame <
mpFile.FrameCount) then
begin
lastFrame := fromFrame + (toFrame - fromFrame + 1) * repeatCount
- 1;
if lastFrame >= mpFile.FrameCount then
MessageDlg('Too many repeats.', mtError, [mbOK], 0) else
begin
destMPFile := TMPFile(opframedlg.ComboBox1.Items.
Objects[opframedlg.ComboBox1.ItemIndex]);
if destMPFile.SizeOfFrameCompatible(mpFile.FrameWidth, mpFile.FrameHeight) then
begin
oldCursor := Screen.Cursor;
try
Screen.Cursor := crHourGlass;
for i := 0 to repeatCount - 1 do
mpFile.AverageFrames(chIndex,
fromFrame + i * (toFrame- fromFrame + 1),
toFrame + i * (toFrame- fromFrame + 1),
destMPFile);
destMPFile.OnNewFrames;
finally
Screen.Cursor := oldCursor;
end;
end;
end;
end
else
MessageDlg('Invalid Average Frames parameters', mtError,
[mbOK], 0);
end;
end;
end;
procedure TViewerFrm.CopyFrames2Click(Sender: TObject);
var fromFrame, toFrame, chIndex: integer;
oldCursor: TCursor;
destMPFile: TMPFile;
begin
if CheckNoFrame then Exit;
if Mainform.fileList.WorkspaceCount = 0 then
MessageDlg('No workspace for this operation.' + CRLF +
'Create a workspace file first.', mtInformation, [mbOK], 0)
else
begin
with opframedlg do
begin
Caption := 'Copy Frames';
opframedlg.InitGUI(mpFile);
Mainform.fileList.
FillComboBoxWithWorkspaces(ComboBox1);
ComboBox1.ItemIndex := 0;
Label1.Caption := 'From Frame';
Label3.Caption := 'To Frame';
SpinEdit1.MinValue := 1;
SpinEdit2.MinValue := 1;
SpinEdit1.MaxValue := mpFile.FrameCount;
SpinEdit2.MaxValue := mpFile.FrameCount;
SpinEdit1.Value := CurrentFrameIndex + 1;
SpinEdit2.Value := CurrentFrameIndex + 1;
Label4.Visible := False;
SpinEdit3.Visible := False;
Label5.Visible := False;
SpinEdit4.Visible := False;
end;
if opframedlg.ShowModal = mrOK then
begin
fromFrame := opframedlg.SpinEdit1.Value - 1;
toFrame := opframedlg.SpinEdit2.Value - 1;
chIndex := opframedlg.SelectedCh;
if (fromFrame <= toFrame) and (fromFrame >= 0) and (fromFrame
< mpFile.FrameCount) and (toFrame >= 0) and (toFrame <
mpFile.FrameCount) then
begin
destMPFile := TMPFile(opframedlg.ComboBox1.Items.
Objects[opframedlg.ComboBox1.ItemIndex]);
if destMPFile.SizeOfFrameCompatible(mpFile.FrameWidth, mpFile.FrameHeight) then
begin
oldCursor := Screen.Cursor;
try
Screen.Cursor := crHourGlass;
mpFile.CopyFrames(chIndex, fromFrame, toFrame,
destMPFile);
destMPFile.OnNewFrames;
finally
Screen.Cursor := oldCursor;
end;
end;
end
else
MessageDlg('Invalid Copy Frames parameters', mtError,
[mbOK], 0);
end;
end;
end;
{Z axis projection}
procedure TViewerFrm.CreateProjection1Click(Sender: TObject);
var fromFrame, toFrame, chIndex: integer;
oldCursor: TCursor;
destMPFile: TMPFile;
begin
if CheckNoFrame then Exit;
if Mainform.fileList.WorkspaceCount = 0 then
MessageDlg('No workspace for this operation.' + CRLF +
'Create a workspace file first.', mtInformation, [mbOK], 0)
else
begin
with opframedlg do
begin
Caption := 'Project Frames on Z axis';
opframedlg.InitGUI(mpFile);
Mainform.
fileList.FillComboBoxWithWorkspaces(ComboBox1);
ComboBox1.ItemIndex := 0;
Label1.Caption := 'From Frame';
Label3.Caption := 'To Frame';
SpinEdit1.MinValue := 1;
SpinEdit2.MinValue := 1;
SpinEdit1.MaxValue := mpFile.FrameCount;
SpinEdit2.MaxValue := mpFile.FrameCount;
SpinEdit1.Value := CurrentFrameIndex + 1;
SpinEdit2.Value := CurrentFrameIndex + 1;
Label4.Visible := False;
SpinEdit3.Visible := False;
Label5.Visible := False;
SpinEdit4.Visible := False;
end;
if opframedlg.ShowModal = mrOK then
begin
fromFrame := opframedlg.SpinEdit1.Value - 1;
toFrame := opframedlg.SpinEdit2.Value - 1;
chIndex := opframedlg.SelectedCh;
if (fromFrame <= toFrame) and (fromFrame >= 0) and (fromFrame
< mpFile.FrameCount) and (toFrame >= 0) and (toFrame <
mpFile.FrameCount) then
begin
destMPFile := TMPFile(opframedlg.ComboBox1.Items.
Objects[opframedlg.ComboBox1.ItemIndex]);
if destMPFile.SizeOfFrameCompatible(mpFile.FrameWidth, mpFile.FrameHeight) then
begin
oldCursor := Screen.Cursor;
try
Screen.Cursor := crHourGlass;
mpFile.StackZ(chIndex, fromFrame, toFrame,
destMPFile);
finally
Screen.Cursor := oldCursor;
end;
end;
end
else
MessageDlg('Invalid Projection Frames parameters', mtError,
[mbOK], 0);
end;
end;
end;
procedure TViewerFrm.ProjectFrameonYaxis1Click(Sender: TObject);
var fromFrame, toFrame, chIndex, fromX, toX: integer;
oldCursor: TCursor;
destMPFile: TMPFile;
begin
if CheckNoFrame then Exit;
if Mainform.fileList.WorkspaceCount = 0 then
MessageDlg('No workspace for this operation.' + CRLF +
'Create a workspace file first.', mtInformation, [mbOK], 0)
else
begin
with opframedlg do
begin
Caption := 'Project Frames on Y axis';
opframedlg.InitGUI(mpFile);
Mainform.fileList.
FillComboBoxWithWorkspaces(ComboBox1);
ComboBox1.ItemIndex := 0;
Label1.Caption := 'From Frame';
Label3.Caption := 'To Frame';
SpinEdit1.MinValue := 1;
SpinEdit2.MinValue := 1;
SpinEdit1.MaxValue := mpFile.FrameCount;
SpinEdit2.MaxValue := mpFile.FrameCount;
SpinEdit1.Value := CurrentFrameIndex + 1;
SpinEdit2.Value := CurrentFrameIndex + 1;
Label4.Visible := True;
Label4.Caption := 'From X';
SpinEdit3.MinValue := 0;
SpinEdit3.MaxValue := mpFile.FrameWidth - 1;
SpinEdit3.Value := 0;
SpinEdit3.Visible := True;
Label5.Visible := True;
Label5.Caption := 'To X';
SpinEdit4.MinValue := 0;
SpinEdit4.MaxValue := mpFile.FrameWidth - 1;
SpinEdit4.Value := mpFile.FrameWidth - 1;
SpinEdit4.Visible := True;
end;
if opframedlg.ShowModal = mrOK then
begin
fromFrame := opframedlg.SpinEdit1.Value - 1;
toFrame := opframedlg.SpinEdit2.Value - 1;
chIndex := opframedlg.SelectedCh;
fromX := opframedlg.SpinEdit3.Value;
toX := opframedlg.SpinEdit4.Value;
if (fromFrame <= toFrame) and (fromFrame >= 0) and (fromFrame
< mpFile.FrameCount) and (toFrame >= 0) and (toFrame <
mpFile.FrameCount) and
(fromX >= 0) and (fromX < mpFile.FrameWidth) and
(toX >= 0) and (toX < mpFile.FrameWidth) and
(toX >= fromX) then
begin
destMPFile := TMPFile(opframedlg.ComboBox1.Items.
Objects[opframedlg.ComboBox1.ItemIndex]);
if destMPFile.SizeOfFrameCompatible(mpFile.FrameHeight,
toFrame - fromFrame + 1) then
begin
oldCursor := Screen.Cursor;
try
Screen.Cursor := crHourGlass;
mpFile.StackY(chIndex, fromFrame, toFrame, fromX, toX,
destMPFile);
finally
Screen.Cursor := oldCursor;
end;
end;
end
else
MessageDlg('Invalid Projection Frames parameters', mtError,
[mbOK], 0);
end;
end;
end;
procedure TViewerFrm.ProjectFramesonXaxis1Click(Sender: TObject);
var fromFrame, toFrame, chIndex, fromY, toY: integer;
oldCursor: TCursor;
destMPFile: TMPFile;
begin
if CheckNoFrame then Exit;
if Mainform.fileList.WorkspaceCount = 0 then
MessageDlg('No workspace for this operation.' + CRLF +
'Create a workspace file first.', mtInformation, [mbOK], 0)
else
begin
with opframedlg do
begin
Caption := 'Project Frames on X axis';
opframedlg.InitGUI(mpFile);
Mainform.fileList.
FillComboBoxWithWorkspaces(ComboBox1);
ComboBox1.ItemIndex := 0;
Label1.Caption := 'From Frame';
Label3.Caption := 'To Frame';
SpinEdit1.MinValue := 1;
SpinEdit2.MinValue := 1;
SpinEdit1.MaxValue := mpFile.FrameCount;
SpinEdit2.MaxValue := mpFile.FrameCount;
SpinEdit1.Value := CurrentFrameIndex + 1;
SpinEdit2.Value := CurrentFrameIndex + 1;
Label4.Visible := True;
Label4.Caption := 'From Y';
SpinEdit3.MinValue := 0;
SpinEdit3.MaxValue := mpFile.FrameHeight - 1;
SpinEdit3.Value := 0;
SpinEdit3.Visible := True;
Label5.Visible := True;
Label5.Caption := 'To Y';
SpinEdit4.MinValue := 0;
SpinEdit4.MaxValue := mpFile.FrameHeight - 1;
SpinEdit4.Value := mpFile.FrameHeight - 1;
SpinEdit4.Visible := True;
end;
if opframedlg.ShowModal = mrOK then
begin
fromFrame := opframedlg.SpinEdit1.Value - 1;
toFrame := opframedlg.SpinEdit2.Value - 1;
chIndex := opframedlg.SelectedCh;
fromY := opframedlg.SpinEdit3.Value;
toY := opframedlg.SpinEdit4.Value;
if (fromFrame <= toFrame) and (fromFrame >= 0) and (fromFrame
< mpFile.FrameCount) and (toFrame >= 0) and (toFrame <
mpFile.FrameCount) and
(fromY >= 0) and (fromY < mpFile.FrameHeight) and
(toY >= 0) and (toY < mpFile.FrameHeight) and
(toY >= fromY) then
begin
destMPFile := TMPFile(opframedlg.ComboBox1.Items.
Objects[opframedlg.ComboBox1.ItemIndex]);
if destMPFile.SizeOfFrameCompatible(mpFile.FrameWidth,
toFrame - fromFrame + 1) then
begin
oldCursor := Screen.Cursor;
try
Screen.Cursor := crHourGlass;
mpFile.StackX(chIndex, fromFrame, toFrame, fromY, toY,
destMPFile);
finally
Screen.Cursor := oldCursor;
end;
end;
end
else
MessageDlg('Invalid Projection Frames parameters', mtError,
[mbOK], 0);
end;
end;
end;
procedure TViewerFrm.SubtractwithFrame1Click(Sender: TObject);
var plusFrame, minusFrame, repeatCount, lastFrame, chIndex, i: integer;
oldCursor: TCursor;
destMPFile: TMPFile;
begin
if CheckNoFrame then Exit;
if Mainform.fileList.WorkspaceCount = 0 then
MessageDlg('No workspace for this operation.' + CRLF +
'Create a workspace file first.', mtInformation, [mbOK], 0)
else
begin
opframedlg.Caption := 'Subtract Frames';
opframedlg.InitGUI(mpFile);
Mainform.fileList.FillComboBoxWithWorkspaces(opframedlg.ComboBox1);
opframedlg.ComboBox1.ItemIndex := 0;
opframedlg.Label1.Caption := '+ Frame';
opframedlg.Label3.Caption := '- Frame';
opframedlg.Label4.Caption := 'Repeat';
opframedlg.SpinEdit3.Enabled := True;
opframedlg.SpinEdit3.Value := 1;
opframedlg.SpinEdit1.MinValue := 1;
opframedlg.SpinEdit2.MinValue := 1;
opframedlg.SpinEdit1.MaxValue := mpFile.FrameCount;
opframedlg.SpinEdit2.MaxValue := mpFile.FrameCount;
opframedlg.SpinEdit1.Value := CurrentFrameIndex + 1;
opframedlg.SpinEdit2.Value := CurrentFrameIndex + 1;
if opframedlg.ShowModal = mrOK then
begin
plusFrame := opframedlg.SpinEdit1.Value - 1;
minusFrame := opframedlg.SpinEdit2.Value - 1;
repeatCount := opframedlg.SpinEdit3.Value;
chIndex := opframedlg.SelectedCh;
if (plusFrame >= 0) and (plusFrame < mpFile.FrameCount) and
(minusFrame >= 0) and (minusFrame < mpFile.FrameCount) then
begin
if plusFrame >= minusFrame then
lastFrame := plusFrame + repeatCount - 1
else
lastFrame := minusFrame + repeatCount - 1;
if lastFrame >= mpFile.FrameCount then
MessageDlg('Too many repeats.', mtError, [mbOK], 0) else
begin
destMPFile := TMPFile(opframedlg.ComboBox1.Items.
Objects[opframedlg.ComboBox1.ItemIndex]);
if destMPFile.SizeOfFrameCompatible(mpFile.FrameWidth,
mpFile.FrameHeight) then
begin
oldCursor := Screen.Cursor;
try
Screen.Cursor := crHourGlass;
for i := 0 to repeatCount - 1 do
mpFile.SubtractFrame(chIndex,
plusFrame + i,
minusFrame + i,
destMPFile);
destMPFile.OnNewFrames;
finally
Screen.Cursor := oldCursor;
end;
end;
end;
end
else
MessageDlg('Invalid Subtract Frames parameters', mtError,
[mbOK], 0);
end;
end;
end;
procedure TViewerFrm.DeleteallROIs1Click(Sender: TObject);
begin
ROIList.Clear;
DrawFrame;
end;
procedure TViewerFrm.MakeAVIMovie1Click(Sender: TObject);
var chIndex, fromFrame, toFrame: integer;
oldCursor: TCursor;
aColorScheme: TColorScheme;
begin
if CheckNoFrame then Exit;
with AVIOptDlg do
begin
GroupBox2.Enabled := True;
RadioButton5.Checked := True;
Label2.Visible := True;
SpinEdit3.Visible := True;
Label4.Visible := True;
InitGUI(mpFile);
SpinEdit1.MinValue := 1;
SpinEdit2.MinValue := 1;
SpinEdit1.MaxValue := mpFile.FrameCount;
SpinEdit2.MaxValue := mpFile.FrameCount;
SpinEdit1.Value := 1;
SpinEdit2.Value := mpFile.FrameCount;
SpinEdit3.Value := Round(mpFile.FrameRate);
Caption := 'Create AVI Movie';
end;
with SaveDialog1 do
begin
DefaultExt := 'AVI';
Filter := 'Video Files (*.AVI)|*.AVI|All Files (*.*)|*.*';
Title := 'Create AVI File';
if Execute then
if AVIOptDlg.ShowModal = mrOK then
begin
chIndex := AVIOptDlg.SelectedCh;
fromFrame := AVIOptDlg.SpinEdit1.Value - 1;
toFrame := AVIOptDlg.SpinEdit2.Value - 1;
if (fromFrame >= 0) and (fromFrame < mpFile.FrameCount) and
(toFrame >= 0) and (toFrame < mpFile.FrameCount) and
(AVIOptDlg.SpinEdit3.Value > 0) then
begin
oldCursor := Screen.Cursor;
if AVIOptDlg.RadioButton5.Checked then
aColorScheme := CS_GRAYSCALE
else if AVIOptDlg.RadioButton6.Checked then
aColorScheme := CS_FALSECOLORS
else
aColorScheme := CS_CUSTOMLUT;
try
Screen.Cursor := crHourGlass;
mpFile.MakeAVIMovie(SaveDialog1.Filename, chIndex,
fromFrame, toFrame, AVIOptDlg.SpinEdit3.Value, aColorScheme, self,
OverlayCh1onCh21.Checked);
finally
Screen.Cursor := oldCursor;
end;
end
else
MessageDlg('Invalid frames', mtError, [mbOK], 0);
end;
end;
end;
procedure TViewerFrm.DeleteallObjects1Click(Sender: TObject);
begin
if mpFile = nil then Exit;
if ROIList.Count = 0 then Exit;
ROIList.Clear;
OnNewFrame;
HideROIs1.Checked := False;
PlotROIofObjects1.Enabled := False;
HideROIs1.Enabled := False;
DeleteallObjects1.Enabled := False;
end;
procedure TViewerFrm.HideROIs1Click(Sender: TObject);
begin
if mpFile = nil then Exit;
if ROIList.Count = 0 then Exit;
HideROIs1.Checked := not HideROIs1.Checked;
OnNewFrame;
end;
procedure TViewerFrm.CreateRectangularROI1Click(Sender: TObject);
begin
if CheckNoFrame then Exit;
CreateRectangularROI1.Checked := not CreateRectangularROI1.Checked;
ToolButton7.Down := CreateRectangularROI1.Checked;
if CreateRectangularROI1.Checked then
begin
ToolButton8.Down := False;
CreateEllipticalROI1.Checked := False;
end;
end;
procedure TViewerFrm.CreateEllipticalROI1Click(Sender: TObject);
begin
if CheckNoFrame then Exit;
CreateEllipticalROI1.Checked := not CreateEllipticalROI1.Checked;
ToolButton8.Down := CreateEllipticalROI1.Checked;
if CreateEllipticalROI1.Checked then
begin
ToolButton7.Down := False;
CreateRectangularROI1.Checked := False;
end;
end;
procedure TViewerFrm.FindObjects1Click(Sender: TObject);
var chIndex, oldROICount, fromFrame, toFrame,
threshold, minArea,
templateFrom, templateTo: integer;
begin
if CheckNoFrame then Exit;
with DetectROIDlg do
begin
CheckBox1.Checked := False;
CheckBox1.Enabled := (mpFile.VideoChCount >= 2);
SetGUI(mpFile); {sets radiobuttons in form}
Label2.Caption := 'Threshold (1..' + IntToStr(mpFile.MaxPixelValue) + ')';
SpinEdit1.MinValue := 1;
SpinEdit2.MinValue := 1;
SpinEdit5.MinValue := 1;
SpinEdit6.MinValue := 1;
SpinEdit1.MaxValue := mpFile.FrameCount;
SpinEdit2.MaxValue := mpFile.FrameCount;
SpinEdit3.MaxValue := mpFile.MaxPixelValue;
SpinEdit5.MaxValue := mpFile.FrameCount;
SpinEdit6.MaxValue := mpFile.FrameCount;
SpinEdit1.Value := 1;
SpinEdit2.Value := mpFile.FrameCount;
SpinEdit5.Value := 1;
SpinEdit6.Value := 10;
end;
if DetectROIDlg.ShowModal = mrOK then
begin
chIndex := DetectROIDlg.SelectedCh;
fromFrame := DetectROIDlg.SpinEdit1.Value - 1;
toFrame := DetectROIDlg.SpinEdit2.Value - 1;
threshold := DetectROIDlg.SpinEdit3.Value;
minArea := DetectROIDlg.SpinEdit4.Value;
templateFrom := DetectROIDlg.SpinEdit5.Value;
templateTo := DetectROIDlg.SpinEdit6.Value;
if (fromFrame >= 0) and (fromFrame < mpFile.FrameCount)
and (toFrame >= 0 ) and (toFrame < mpFile.FrameCount)
and (threshold > 0) and (threshold <= 2047)
and (minArea > 0) and (minArea < mpFile.FrameWidth * mpFile.FrameHeight)
and (templateFrom >= 0 ) and (templateFrom < mpFile.FrameCount)
and (templateTo >= 0 ) and (templateTo < mpFile.FrameCount)
and (templateFrom <= templateTo ) then
begin
oldROICount := ROIList.Count;
try
Screen.Cursor := crHourGlass;
mpFile.DetectROIs(ROIList, chIndex, fromFrame, toFrame, threshold, minArea, templateFrom, templateTo);
Screen.Cursor := crDefault;
MessageDlg(IntToStr(ROIList.Count - oldROICount) + ' ROIs found.',
mtInformation, [mbOK], 0);
if ROIList.Count > oldROICount then
begin
HideROIs1.Enabled := True;
PlotROIofObjects1.Enabled := True;
DeleteallObjects1.Enabled := True;
if DetectROIDlg.CheckBox1.Checked then mpFile.CloneROIs(ROIList, oldROICount);
OnNewFrame;
end;
except
Screen.Cursor := crDefault;
end;
end
else
MessageDlg('Invalid parameter(s) to detect ROIs.', mtError, [mbOK], 0);
end;
end;
procedure TViewerFrm.PlotROIofObjects1Click(Sender: TObject);
begin
SelectROIPlot(True, 0);
end;
procedure TViewerFrm.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var origin: TPoint;
sc: TRect;
begin
if mpFile = nil then Exit;
if mpFile.FrameCount = 0 then Exit;
origin := ClientOrigin;
if CreateRectangularROI1.Checked or CreateLineProfile1.Checked or
AreaStats1.Checked or CreateEllipticalROI1.Checked then
begin
if WindowToChannel(X, Y, currentChannel) then
if mpFile.VideoChEnabled[currentChannel] then
begin
sc := chRect[currentChannel];
OffsetRect(sc, origin.X, origin.Y);
ClipCursor(@sc);
if CreateRectangularROI1.Checked then
mouseAction := maRectangularROI
else if CreateEllipticalROI1.Checked then
mouseAction := maEllipticROI
else if CreateLineProfile1.Checked then
mouseAction := maLineProfile
else if AreaStats1.Checked then
mouseAction := maStats;
if (mouseAction = maRectangularROI) or (mouseAction = maLineProfile) or
(mouseAction = maStats) or (mouseAction = maEllipticROI) then
begin
anchorX := X;
anchorY := Y;
prevX := X;
prevY := Y;
with Canvas do
begin
Pen.Color := clWhite;
Pen.Style := psDot;
Pen.Mode := pmXor;
Pen.Width := 1;
end;
if mouseAction <> maEllipticROI then
Canvas.Polyline([Point(AnchorX, AnchorY), Point(AnchorX, prevY), Point(prevX, prevY),
Point(prevX, AnchorY), Point(AnchorX, AnchorY)])
else
Canvas.Arc(AnchorX, AnchorY, X, Y, AnchorX, AnchorY, AnchorX, AnchorY);
end;
end;
end
else
begin
mouseAction := maNormal;
if not WindowToChannel(X, Y, currentChannel) then currentChannel := -1;
end;
end;
procedure TViewerFrm.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var xData, yData, pixelValue: integer;
roiIndex: integer;
begin
if mpFile = nil then Exit;
if WindowToChannel(X, Y, currentChannel) then
begin
if mpFile.VideoChEnabled[currentChannel] then
begin
StatusBar1.Panels[1].Text := 'Ch' + IntToStr(currentChannel + 1);
xData := WindowToFrameX(currentChannel, X);
yData := WindowToFrameY(Y);
pixelValue := mpFile.GetPixelValue(CurrentFrameIndex, currentChannel, xData, yData);
StatusBar1.Panels[2].Text := 'X: ' + IntToStr(xData);
StatusBar1.Panels[3].Text := 'Y: ' + IntToStr(yData);
StatusBar1.Panels[4].Text := 'Pixel: ' + IntToStr(pixelValue);
end
end
else
currentChannel := -1;
if (mouseAction = maRectangularROI) or (mouseAction = maStats) then
begin
Canvas.Polyline([Point(AnchorX, AnchorY), Point(AnchorX, prevY), Point(prevX, prevY),
Point(prevX, AnchorY), Point(AnchorX, AnchorY)]);
prevX := X; prevY := Y;
Canvas.Polyline([Point(AnchorX, AnchorY), Point(AnchorX, prevY), Point(prevX, prevY),
Point(prevX, AnchorY), Point(AnchorX, AnchorY)]);
end
else if mouseAction = maEllipticROI then
begin
Canvas.Arc(AnchorX, AnchorY, prevX, prevY, AnchorX, AnchorY, AnchorX, AnchorY);
prevX := X; prevY := Y;
Canvas.Arc(AnchorX, AnchorY, prevX, prevY, AnchorX, AnchorY, AnchorX, AnchorY);
end
else if mouseAction = maLineProfile then
begin
Canvas.Polyline([Point(AnchorX, AnchorY), Point(prevX, prevY)]);
prevX := X; prevY := Y;
Canvas.Polyline([Point(AnchorX, AnchorY), Point(prevX, prevY)]);
end
else if mouseAction = maNormal then
if currentChannel >= 0 then
begin
roiPt.x := WindowToFrameX(currentChannel, X);
roiPt.y := WindowToFrameY(Y);
roiIndex := ROIList.ROIOfPt(currentChannel, roiPt);
if roiIndex > - 1 then
StatusBar1.Panels[5].Text := 'ROI: ' + IntToStr(roiIndex + 1)
else
StatusBar1.Panels[5].Text := 'ROI:';
end;
end;
const
sCreateOtherChROI = 'Do you want to create the same ROI in the other channels?';
procedure TViewerFrm.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var rc: TRect;
otherChannel: integer;
begin
if mouseAction = maRectangularROI then
begin
mouseAction := maNormal;
CreateRectangularROI1Click(nil); {reset to normal mode}
ClipCursor(nil);
rc.Left := WindowToFrameX(currentChannel, anchorX);
rc.Right := WindowToFrameX(currentChannel, X);
rc.Top := WindowToFrameY(anchorY);
rc.Bottom := WindowToFrameY(Y);
ROIList.AddRectangularROI(currentChannel, rc);
SelectROIPlot(False, ROIList.Count - 1);
if mpFile.VideoChCount >= 2 then
if MessageDlg(sCreateOtherChROI, mtInformation, [mbOK, mbCancel], 0) = mrOK then
for otherChannel := 0 to MAX_CH - 1 do
if mpFile.VideoChEnabled[otherChannel] and (otherChannel <> currentChannel) then
begin
ROIList.AddRectangularROI(otherChannel, rc);
SelectROIPlot(False, ROIList.Count - 1);
end;
OnNewFrame;
HideROIs1.Enabled := True;
PlotROIofObjects1.Enabled := True;
DeleteallObjects1.Enabled := True;
end
else if mouseAction = maEllipticROI then
begin
mouseAction := maNormal;
CreateEllipticalROI1Click(nil); {reset to normal mode}
ClipCursor(nil);
rc.Left := WindowToFrameX(currentChannel, anchorX);
rc.Right := WindowToFrameX(currentChannel, X);
rc.Top := WindowToFrameY(anchorY);
rc.Bottom := WindowToFrameY(Y);
ROIList.AddEllipticalROI(currentChannel, rc);
SelectROIPlot(False, ROIList.Count - 1);
if mpFile.VideoChCount >= 2 then
if MessageDlg(sCreateOtherChROI, mtInformation, [mbOK, mbCancel], 0) = mrOK then
for otherChannel := 0 to MAX_CH - 1 do
if mpFile.VideoChEnabled[otherChannel] and (otherChannel <> currentChannel) then
begin
ROIList.AddEllipticalROI(otherChannel, rc);
SelectROIPlot(False, ROIList.Count - 1);
end;
OnNewFrame;
HideROIs1.Enabled := True;
PlotROIofObjects1.Enabled := True;
DeleteallObjects1.Enabled := True;
end
else if mouseAction = maLineProfile then
begin
mouseAction := maNormal;
ClipCursor(nil);
Canvas.Polyline([Point(AnchorX, AnchorY), Point(prevX, prevY)]);
rc.Left := WindowToFrameX(currentChannel, anchorX);
rc.Right := WindowToFrameX(currentChannel, X);
rc.Top := WindowToFrameY(anchorY);
rc.Bottom := WindowToFrameY(Y);
PlotLineProfile(currentChannel, rc);
CreateLineProfile1Click(nil); {reset to normal mode}
end
else if mouseAction = maStats then
begin
AreaStats1Click(nil);
mouseAction := maNormal;
ClipCursor(nil);
{erase rectangle}
Canvas.Polyline([Point(AnchorX, AnchorY), Point(AnchorX, prevY), Point(prevX, prevY),
Point(prevX, AnchorY), Point(AnchorX, AnchorY)]);
rc.Left := WindowToFrameX(currentChannel, anchorX);
rc.Right := WindowToFrameX(currentChannel, X);
rc.Top := WindowToFrameY(anchorY);
rc.Bottom := WindowToFrameY(Y);
StatDlg.Initialize(mpFile, CurrentFrameIndex, currentChannel, rc);
StatDlg.ShowModal;
end
else if mouseAction = maNormal then
if currentChannel >= 0 then
begin
roiPt.x := WindowToFrameX(currentChannel, X);
roiPt.y := WindowToFrameY(Y);
end;
end;
procedure TViewerFrm.FormDblClick(Sender: TObject);
var roiIndex: integer;
begin
if (mouseAction = maNormal) and (currentChannel >= 0) then
begin
roiIndex := ROIList.ROIOfPt(currentChannel, roiPt);
if roiIndex > - 1 then
SelectROIPlot(False, roiIndex);
end;
end;
procedure TViewerFrm.CreateLineProfile1Click(Sender: TObject);
begin
CreateLineProfile1.Checked := not CreateLineProfile1.Checked;
ToolButton9.Down := CreateLineProfile1.Checked;
end;
procedure TViewerFrm.CopyFrames1Click(Sender: TObject);
var fromFrame, toFrame, chIndex: integer;
s: string;
begin
if CheckNoFrame then Exit;
with MTransferDlg do
begin
InitGUI(mpFile);
SpinEdit1.MinValue := 1;
SpinEdit2.MinValue := 1;
SpinEdit1.MaxValue := mpFile.FrameCount;
SpinEdit2.MaxValue := mpFile.FrameCount;
SpinEdit1.Value := CurrentFrameIndex + 1;
SpinEdit2.Value := CurrentFrameIndex + 1;
ListBox1.ItemIndex := 0;
if MTransferDlg.ShowModal = mrOK then
begin
fromFrame := SpinEdit1.Value - 1;
toFrame := SpinEdit2.Value - 1;
if ListBox1.ItemIndex = 0 then s := 'base' else s := 'workspace';
chIndex := SelectedCh;
if (fromFrame >= 0) and (fromFrame < mpFile.FrameCount) and
(toFrame >= 0) and (toFrame < mpFile.FrameCount) and
(SpinEdit3.Value > 0) and (fromFrame <= toFrame) then
ExportToMatlab(chIndex, fromFrame, toFrame, Edit1.Text, SpinEdit3.Value,
s)
else
MessageDlg('Invalid parameters.', mtError, [mbOK], 0);
end;
end;
end;
procedure TViewerFrm.AutomaticBackgroundCorrection1Click(Sender: TObject);
begin
if CheckNoFrame then Exit;
AutomaticBackgroundCorrection1.Checked := not AutomaticBackgroundCorrection1.Checked;
mpFile.DoBackgroundCorrection;
DrawFrame;
end;
procedure TViewerFrm.AreaStats1Click(Sender: TObject);
begin
if mouseAction = maNormal then
AreaStats1.Checked := True
else if mouseAction = maStats then
AreaStats1.Checked := False;
end;
procedure TViewerFrm.ExportFramesasamultipageTIFFfile1Click(
Sender: TObject);
var chIndex, fromFrame, toFrame: integer;
oldCursor: TCursor;
bNoNegativeValues: boolean;
begin
if CheckNoFrame then Exit;
with AVIOptDlg do
begin
InitGUI(mpFile);
SpinEdit1.MinValue := 1;
SpinEdit2.MinValue := 1;
SpinEdit1.MaxValue := mpFile.FrameCount;
SpinEdit2.MaxValue := mpFile.FrameCount;
SpinEdit1.Value := 1;
SpinEdit2.Value := mpFile.FrameCount;
Caption := 'Export as TIFF file';
RadioButton5.Checked := True;
GroupBox2.Enabled := False;
Label2.Visible := False;
SpinEdit3.Visible := False;
Label4.Visible := False;
end;
with SaveDialog1 do
begin
DefaultExt := 'TIF';
Filter := 'TIFF Files (*.TIF)|*.TIF|All Files (*.*)|*.*';
Title := 'Export as TIFF file';
if Execute then
if AVIOptDlg.ShowModal = mrOK then
begin
chIndex := AVIOptDlg.SelectedCh;
fromFrame := AVIOptDlg.SpinEdit1.Value - 1;
toFrame := AVIOptDlg.SpinEdit2.Value - 1;
if (fromFrame >= 0) and (fromFrame < mpFile.FrameCount) and
(toFrame >= 0) and (toFrame < mpFile.FrameCount)
and (fromFrame <= toFrame) then
begin
oldCursor := Screen.Cursor;
try
Screen.Cursor := crHourGlass;
bNoNegativeValues := mpFile.MakeTIFF(SaveDialog1.Filename, chIndex,
fromFrame, toFrame);
Screen.Cursor := oldCursor;
if not bNoNegativeValues then
MessageDlg('Negative pixel values changed to 0.',
mtWarning, [mbOK], 0);
MessageDlg('Successfully exported frames in TIFF file.',
mtInformation, [mbOK], 0);
except
Screen.Cursor := oldCursor;
MessageDlg('Error in creating TIFF file.',
mtError, [mbOK], 0);
end;
end
else
MessageDlg('Invalid frames', mtError, [mbOK], 0);
end;
end;
end;
procedure TViewerFrm.CustomColors1Click(Sender: TObject);
begin
if CustomColors1.Checked then Exit;
CustomColors1.Checked := True;
colorScheme := CS_CUSTOMLUT;
FalseColors1.Checked := False;
GrayScale1.Checked := False;
MakeColorScale;
DrawFrame;
end;
procedure TViewerFrm.FalseColors1Click(Sender: TObject);
begin
if FalseColors1.Checked then Exit;
FalseColors1.Checked := True;
colorScheme := CS_FALSECOLORS;
CustomColors1.Checked := False;
GrayScale1.Checked := False;
MakeColorScale;
DrawFrame;
end;
procedure TViewerFrm.CustomColorsLookupTable1Click(Sender: TObject);
begin
LUTDlg := TLUTDlg.Create(Mainform);
with LUTDlg, mpFile do
begin
viewer := Self;
dlgBaseColors := baseColors;
dlgnegativeColors := negativeColors;
dlgmidRangeColors := midRangeColors;
dlgmaxColors := maxColors;
dlgMaxPixels := maxPixels;
end;
if LUTDlg.ShowModal = mrOK then
begin
SetLUTColors;
if colorScheme <> CS_CUSTOMLUT then
CustomColors1Click(nil);
LUTDlg.Free;
Invalidate;
end
else
LUTDlg.Free;
end;
procedure TViewerFrm.PaintBox1Paint(Sender: TObject);
begin
MakeColorScale;
end;
procedure TViewerFrm.BinaryFrameOperations1Click(Sender: TObject);
begin
if not Mainform.bBinaryOp then
if Mainform.fileList.WorkspaceCount = 0 then
MessageDlg('No workspace to store result frame.', mtError, [mbOK], 0)
else
begin
BinOpForm := TBinOpForm.Create(mainform);
BinOpForm.Show;
Mainform.bBinaryOp := True;
end;
end;
procedure TViewerFrm.OverlayCh1onCh21Click(Sender: TObject);
begin
OverlayCh1onCh21.Checked := not OverlayCh1onCh21.Checked;
DrawFrame;
end;
procedure TViewerFrm.OverlayCh2onCh31Click(Sender: TObject);
begin
OverlayCh2onCh31.Checked := not OverlayCh2onCh31.Checked;
DrawFrame;
end;
end.
Raw
Zoom Button
unit Zoombtns;
interface
uses Windows, Classes, StdCtrls, ExtCtrls, Controls, Messages, SysUtils,
Forms, Graphics, Menus, Buttons;
const
InitRepeatPause = 400; { pause before repeat timer (ms) }
RepeatPause = 100; { pause before hint window displays (ms)}
type
TTimerHZoomButton = class;
{ THZoomButton }
THZoomButton = class (TWinControl)
private
FLeftButton: TTimerHZoomButton;
FRightButton: TTimerHZoomButton;
FFocusedButton: TTimerHZoomButton;
FFocusControl: TWinControl;
FOnUpClick: TNotifyEvent;
FOnDownClick: TNotifyEvent;
function CreateButton: TTimerHZoomButton;
function GetLeftGlyph: TBitmap;
function GetRightGlyph: TBitmap;
procedure SetLeftGlyph(Value: TBitmap);
procedure SetRightGlyph(Value: TBitmap);
procedure BtnClick(Sender: TObject);
procedure BtnMouseDown (Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure SetFocusBtn (Btn: TTimerHZoomButton);
procedure WMSize(var Message: TWMSize); message WM_SIZE;
procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
procedure zAdjustSize (var W: Integer; var H: Integer);
protected
procedure Loaded; override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
public
constructor Create(AOwner: TComponent); override;
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
published
property Align;
property Ctl3D;
property RightGlyph: TBitmap read GetRightGlyph write SetRightGlyph;
property DragCursor;
property DragMode;
property Enabled;
property FocusControl: TWinControl read FFocusControl write FFocusControl;
property ParentCtl3D;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property TabOrder;
property TabStop;
property LeftGlyph: TBitmap read GetLeftGlyph write SetLeftGlyph;
property Visible;
property OnDownClick: TNotifyEvent read FOnDownClick write FOnDownClick;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnUpClick: TNotifyEvent read FOnUpClick write FOnUpClick;
end;
{ THZoomEdit }
THZoomEdit = class(TCustomEdit)
private
FMinValue: LongInt;
FMaxValue: LongInt;
FIncrement: LongInt;
FButton: THZoomButton;
FEditorEnabled: Boolean;
function GetMinHeight: Integer;
function GetValue: LongInt;
function CheckValue (NewValue: LongInt): LongInt;
procedure SetValue (NewValue: LongInt);
procedure SetEditRect;
procedure WMSize(var Message: TWMSize); message WM_SIZE;
procedure CMEnter(var Message: TCMGotFocus); message CM_ENTER;
procedure CMExit(var Message: TCMExit); message CM_EXIT;
procedure WMPaste(var Message: TWMPaste); message WM_PASTE;
procedure WMCut(var Message: TWMCut); message WM_CUT;
protected
function IsValidChar(Key: Char): Boolean; virtual;
procedure UpClick (Sender: TObject); virtual;
procedure DownClick (Sender: TObject); virtual;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure KeyPress(var Key: Char); override;
procedure CreateParams(var Params: TCreateParams); override;
procedure CreateWnd; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Button: THZoomButton read FButton;
published
property AutoSelect;
property AutoSize;
property Color;
property Ctl3D;
property DragCursor;
property DragMode;
property EditorEnabled: Boolean read FEditorEnabled write FEditorEnabled default True;
property Enabled;
property Font;
property Increment: LongInt read FIncrement write FIncrement default 1;
property MaxLength;
property MaxValue: LongInt read FMaxValue write FMaxValue;
property MinValue: LongInt read FMinValue write FMinValue;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ReadOnly;
property ShowHint;
property TabOrder;
property TabStop;
property Value: LongInt read GetValue write SetValue;
property Visible;
property OnChange;
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
end;
{ TTimerHZoomButton }
TTimeBtnState = set of (tbFocusRect, tbAllowTimer);
TTimerHZoomButton = class(TSpeedButton)
private
FRepeatTimer: TTimer;
FTimeBtnState: TTimeBtnState;
procedure TimerExpired(Sender: TObject);
protected
procedure Paint; override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
public
destructor Destroy; override;
property TimeBtnState: TTimeBtnState read FTimeBtnState write FTimeBtnState;
end;
procedure Register;
implementation
{$R BTNSSPIN}
{ THZoomButton }
constructor THZoomButton.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle - [csAcceptsControls, csSetCaption] +
[csFramed, csOpaque];
FLeftButton := CreateButton;
FRightButton := CreateButton;
LeftGlyph := nil;
RightGlyph := nil;
Width := 40;
Height := 20;
FFocusedButton := FLeftButton;
end;
function THZoomButton.CreateButton: TTimerHZoomButton;
begin
Result := TTimerHZoomButton.Create (Self);
Result.OnClick := BtnClick;
Result.OnMouseDown := BtnMouseDown;
Result.Visible := True;
Result.Enabled := True;
Result.TimeBtnState := [tbAllowTimer];
Result.NumGlyphs := 1;
Result.Parent := Self;
end;
procedure THZoomButton.zAdjustSize (var W: Integer; var H: Integer);
begin
if (FLeftButton = nil) or (csLoading in ComponentState) then Exit;
if W < 15 then W := 15;
FLeftButton.SetBounds (0, 0, W div 2, H);
FRightButton.SetBounds (W div 2, 0, W - FLeftButton.Width, H);
end;
procedure THZoomButton.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
var
W, H: Integer;
begin
W := AWidth;
H := AHeight;
zAdjustSize (W, H);
inherited SetBounds (ALeft, ATop, W, H);
end;
procedure THZoomButton.WMSize(var Message: TWMSize);
var
W, H: Integer;
begin
inherited;
{ check for minimum size }
W := Width;
H := Height;
zAdjustSize (W, H);
if (W <> Width) or (H <> Height) then
inherited SetBounds(Left, Top, W, H);
Message.Result := 0;
end;
procedure THZoomButton.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
Message.Result := 1;
end;
procedure THZoomButton.WMSetFocus(var Message: TWMSetFocus);
begin
FFocusedButton.TimeBtnState := FFocusedButton.TimeBtnState + [tbFocusRect];
FFocusedButton.Invalidate;
end;
procedure THZoomButton.WMKillFocus(var Message: TWMKillFocus);
begin
FFocusedButton.TimeBtnState := FFocusedButton.TimeBtnState - [tbFocusRect];
FFocusedButton.Invalidate;
end;
procedure THZoomButton.KeyDown(var Key: Word; Shift: TShiftState);
begin
case Key of
VK_UP:
begin
SetFocusBtn (FLeftButton);
FLeftButton.Click;
end;
VK_DOWN:
begin
SetFocusBtn (FRightButton);
FRightButton.Click;
end;
VK_SPACE:
FFocusedButton.Click;
end;
end;
procedure THZoomButton.BtnMouseDown (Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
begin
SetFocusBtn (TTimerHZoomButton (Sender));
if (FFocusControl <> nil) and FFocusControl.TabStop and
FFocusControl.CanFocus and (GetFocus <> FFocusControl.Handle) then
FFocusControl.SetFocus
else if TabStop and (GetFocus <> Handle) and CanFocus then
SetFocus;
end;
end;
procedure THZoomButton.BtnClick(Sender: TObject);
begin
if Sender = FLeftButton then
begin
if Assigned(FOnUpClick) then FOnUpClick(Self);
end
else
if Assigned(FOnDownClick) then FOnDownClick(Self);
end;
procedure THZoomButton.SetFocusBtn (Btn: TTimerHZoomButton);
begin
if TabStop and CanFocus and (Btn <> FFocusedButton) then
begin
FFocusedButton.TimeBtnState := FFocusedButton.TimeBtnState - [tbFocusRect];
FFocusedButton := Btn;
if (GetFocus = Handle) then
begin
FFocusedButton.TimeBtnState := FFocusedButton.TimeBtnState + [tbFocusRect];
Invalidate;
end;
end;
end;
procedure THZoomButton.WMGetDlgCode(var Message: TWMGetDlgCode);
begin
Message.Result := DLGC_WANTARROWS;
end;
procedure THZoomButton.Loaded;
var
W, H: Integer;
begin
inherited Loaded;
W := Width;
H := Height;
zAdjustSize (W, H);
if (W <> Width) or (H <> Height) then
inherited SetBounds (Left, Top, W, H);
end;
function THZoomButton.GetLeftGlyph: TBitmap;
begin
Result := FLeftButton.Glyph;
end;
procedure THZoomButton.SetLeftGlyph(Value: TBitmap);
begin
if Value <> nil then
FLeftButton.Glyph := Value
else
begin
FLeftButton.Glyph.Handle := LoadBitmap(HInstance, 'BITMAP_1');
FLeftButton.NumGlyphs := 1;
FLeftButton.Invalidate;
end;
end;
function THZoomButton.GetRightGlyph: TBitmap;
begin
Result := FRightButton.Glyph;
end;
procedure THZoomButton.SetRightGlyph(Value: TBitmap);
begin
if Value <> nil then
FRightButton.Glyph := Value
else
begin
FRightButton.Glyph.Handle := LoadBitmap(HInstance, 'BITMAP_2');
FRightButton.NumGlyphs := 1;
FRightButton.Invalidate;
end;
end;
{ THZoomEdit }
constructor THZoomEdit.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FButton := THZoomButton.Create (Self);
FButton.Width := 18;
FButton.Height := 40;
FButton.Visible := True;
FButton.Parent := Self;
FButton.FocusControl := Self;
FButton.OnUpClick := UpClick;
FButton.OnDownClick := DownClick;
Text := '0';
ControlStyle := ControlStyle - [csSetCaption];
FIncrement := 1;
FEditorEnabled := True;
end;
destructor THZoomEdit.Destroy;
begin
FButton := nil;
inherited Destroy;
end;
procedure THZoomEdit.KeyDown(var Key: Word; Shift: TShiftState);
begin
if Key = VK_UP then UpClick (Self)
else if Key = VK_DOWN then DownClick (Self);
inherited KeyDown(Key, Shift);
end;
procedure THZoomEdit.KeyPress(var Key: Char);
begin
if not IsValidChar(Key) then
begin
Key := #0;
MessageBeep(0)
end;
if Key <> #0 then inherited KeyPress(Key);
end;
function THZoomEdit.IsValidChar(Key: Char): Boolean;
begin
Result := (Key in [DecimalSeparator, '+', '-', '0'..'9']) or
((Key < #32) and (Key <> Chr(VK_RETURN)));
if not FEditorEnabled and Result and ((Key >= #32) or
(Key = Char(VK_BACK)) or (Key = Char(VK_DELETE))) then
Result := False;
end;
procedure THZoomEdit.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
{ Params.Style := Params.Style and not WS_BORDER; }
Params.Style := Params.Style or ES_MULTILINE or WS_CLIPCHILDREN;
end;
procedure THZoomEdit.CreateWnd;
begin
inherited CreateWnd;
SetEditRect;
end;
procedure THZoomEdit.SetEditRect;
var
Loc: TRect;
begin
SendMessage(Handle, EM_GETRECT, 0, LongInt(@Loc));
Loc.Bottom := ClientHeight + 1; {+1 is workaround for windows paint bug}
Loc.Right := ClientWidth - FButton.Width - 2;
Loc.Top := 0;
Loc.Left := 0;
SendMessage(Handle, EM_SETRECTNP, 0, LongInt(@Loc));
SendMessage(Handle, EM_GETRECT, 0, LongInt(@Loc)); {debug}
end;
procedure THZoomEdit.WMSize(var Message: TWMSize);
var
MinHeight: Integer;
begin
inherited;
MinHeight := GetMinHeight;
{ text edit bug: if size to less than minheight, then edit ctrl does
not display the text }
if Height < MinHeight then
Height := MinHeight
else if FButton <> nil then
begin
FButton.SetBounds (Width - FButton.Width, 0, FButton.Width, Height);
SetEditRect;
end;
end;
function THZoomEdit.GetMinHeight: Integer;
var
DC: HDC;
SaveFont: HFont;
I: Integer;
SysMetrics, Metrics: TTextMetric;
begin
DC := GetDC(0);
GetTextMetrics(DC, SysMetrics);
SaveFont := SelectObject(DC, Font.Handle);
GetTextMetrics(DC, Metrics);
SelectObject(DC, SaveFont);
ReleaseDC(0, DC);
I := SysMetrics.tmHeight;
if I > Metrics.tmHeight then I := Metrics.tmHeight;
Result := Metrics.tmHeight + I div 4 + GetSystemMetrics(SM_CYBORDER) * 4 + 2;
end;
procedure THZoomEdit.UpClick (Sender: TObject);
begin
if ReadOnly then MessageBeep(0)
else Value := Value + FIncrement;
end;
procedure THZoomEdit.DownClick (Sender: TObject);
begin
if ReadOnly then MessageBeep(0)
else Value := Value - FIncrement;
end;
procedure THZoomEdit.WMPaste(var Message: TWMPaste);
begin
if not FEditorEnabled or ReadOnly then Exit;
inherited;
end;
procedure THZoomEdit.WMCut(var Message: TWMPaste);
begin
if not FEditorEnabled or ReadOnly then Exit;
inherited;
end;
procedure THZoomEdit.CMExit(var Message: TCMExit);
begin
inherited;
if CheckValue (Value) <> Value then
SetValue (Value);
end;
function THZoomEdit.GetValue: LongInt;
begin
try
Result := StrToInt (Text);
except
Result := FMinValue;
end;
end;
procedure THZoomEdit.SetValue (NewValue: LongInt);
begin
Text := IntToStr (CheckValue (NewValue));
end;
function THZoomEdit.CheckValue (NewValue: LongInt): LongInt;
begin
Result := NewValue;
if (FMaxValue <> FMinValue) then
begin
if NewValue < FMinValue then
Result := FMinValue
else if NewValue > FMaxValue then
Result := FMaxValue;
end;
end;
procedure THZoomEdit.CMEnter(var Message: TCMGotFocus);
begin
if AutoSelect and not (csLButtonDown in ControlState) then
SelectAll;
inherited;
end;
{TTimerHZoomButton}
destructor TTimerHZoomButton.Destroy;
begin
if FRepeatTimer <> nil then
FRepeatTimer.Free;
inherited Destroy;
end;
procedure TTimerHZoomButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited MouseDown (Button, Shift, X, Y);
if tbAllowTimer in FTimeBtnState then
begin
if FRepeatTimer = nil then
FRepeatTimer := TTimer.Create(Self);
FRepeatTimer.OnTimer := TimerExpired;
FRepeatTimer.Interval := InitRepeatPause;
FRepeatTimer.Enabled := True;
end;
end;
procedure TTimerHZoomButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited MouseUp (Button, Shift, X, Y);
if FRepeatTimer <> nil then
FRepeatTimer.Enabled := False;
end;
procedure TTimerHZoomButton.TimerExpired(Sender: TObject);
begin
FRepeatTimer.Interval := RepeatPause;
if (FState = bsDown) and MouseCapture then
begin
try
Click;
except
FRepeatTimer.Enabled := False;
raise;
end;
end;
end;
procedure TTimerHZoomButton.Paint;
var
R: TRect;
begin
inherited Paint;
if tbFocusRect in FTimeBtnState then
begin
R := Bounds(0, 0, Width, Height);
InflateRect(R, -3, -3);
if FState = bsDown then
OffsetRect(R, 1, 1);
{DrawFocusRect(Canvas.Handle, R);}
end;
end;
procedure Register;
begin
RegisterComponents('Samples', [THZoomButton]);
end;
end.
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment