source: cprs/branches/foia-cprs/CPRS-Chart/Orders/fODLabOthCollSamp.pas@ 712

Last change on this file since 712 was 459, checked in by Kevin Toppenberg, 16 years ago

Adding foia-cprs branch

File size: 2.4 KB
Line 
1unit fODLabOthCollSamp;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 ExtCtrls, ORCtrls, StdCtrls, ORFn;
8
9type
10 TfrmODLabOthCollSamp = class(TForm)
11 pnlBase: TORAutoPanel;
12 cboOtherCollSamp: TORComboBox;
13 cmdOK: TButton;
14 cmdCancel: TButton;
15 procedure cmdCancelClick(Sender: TObject);
16 procedure cmdOKClick(Sender: TObject);
17 procedure cboOtherCollSampDblClick(Sender: TObject);
18 private
19 FOtherCollSamp: string;
20 end;
21
22function SelectOtherCollSample(FontSize: Integer; Skip: integer; CollSampList: TList): string ;
23
24implementation
25
26{$R *.DFM}
27
28uses fODLab, rODLab;
29
30const
31 TX_NOCOLLSAMP_TEXT = 'Select a collection sample or press Cancel.';
32 TX_NOCOLLSAMP_CAP = 'Missing Collection Sample';
33
34function SelectOtherCollSample(FontSize: Integer; Skip: integer; CollSampList: TList): string ;
35{ displays collection sample select form for lab and returns a record of the selection }
36var
37 frmODLabOthCollSamp: TfrmODLabOthCollSamp;
38 W, H, i: Integer;
39 x: string;
40begin
41 frmODLabOthCollSamp := TfrmODLabOthCollSamp.Create(Application);
42 try
43 with frmODLabOthCollSamp do
44 begin
45 Font.Size := FontSize;
46 W := ClientWidth;
47 H := ClientHeight;
48 ResizeToFont(FontSize, W, H);
49 ClientWidth := W; pnlBase.Width := W;
50 ClientHeight := H; pnlBase.Height := H;
51 with CollSampList do for i := Skip to Count-1 do with TCollSamp(Items[i]) do
52 begin
53 x := IntToStr(CollSampID) + '^' + CollSampName;
54 if Length(TubeColor) <> 0 then x := x + ' (' + TubeColor + ')';
55 cboOtherCollSamp.Items.Add(x) ;
56 end;
57 ShowModal;
58 Result := FOtherCollSamp;
59 end;
60 finally
61 frmODLabOthCollSamp.Release;
62 end;
63end;
64
65procedure TfrmODLabOthCollSamp.cmdCancelClick(Sender: TObject);
66begin
67 FOtherCollSamp := '-1' ;
68 Close;
69end;
70
71procedure TfrmODLabOthCollSamp.cmdOKClick(Sender: TObject);
72begin
73 if cboOtherCollSamp.ItemIEN = 0 then
74 begin
75 InfoBox(TX_NOCOLLSAMP_TEXT, TX_NOCOLLSAMP_CAP, MB_OK or MB_ICONWARNING);
76 Exit;
77 end;
78 if cboOtherCollSamp.ItemIEN > 0 then
79 FOtherCollSamp := cboOtherCollSamp.Items[cboOtherCollSamp.ItemIndex]
80 else
81 FOtherCollSamp := '-1' ;
82 Close;
83end;
84
85procedure TfrmODLabOthCollSamp.cboOtherCollSampDblClick(Sender: TObject);
86begin
87 cmdOKClick(Self);
88end;
89
90end.
Note: See TracBrowser for help on using the repository browser.