source: cprs/branches/foia-cprs/CPRS-Chart/Orders/fOrderComment.pas@ 697

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

Adding foia-cprs branch

File size: 2.4 KB
RevLine 
[459]1unit fOrderComment;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 fAutoSz, StdCtrls, ComCtrls, ORFn, rOrders;
8
9type
10 TfrmWardComments = class(TfrmAutoSz)
11 Label1: TLabel;
12 cmdOK: TButton;
13 cmdCancel: TButton;
14 memOrder: TMemo;
15 memComments: TRichEdit;
16 procedure FormCreate(Sender: TObject);
17 procedure cmdOKClick(Sender: TObject);
18 procedure cmdCancelClick(Sender: TObject);
19 procedure memCommentsKeyUp(Sender: TObject; var Key: Word;
20 Shift: TShiftState);
21 private
22 OKPressed: Boolean;
23 end;
24
25function ExecuteWardComments(AnOrder: TOrder): Boolean;
26
27implementation
28
29{$R *.DFM}
30
31const
32 TC_PUT_ERR = 'Unable to Save Comments';
33
34function ExecuteWardComments(AnOrder: TOrder): Boolean;
35var
36 frmWardComments: TfrmWardComments;
37 ErrMsg: string;
38begin
39 Result := False;
40 frmWardComments := TfrmWardComments.Create(Application);
41 try
42 ResizeFormToFont(TForm(frmWardComments));
43 with frmWardComments do
44 begin
45 memOrder.SetTextBuf(PChar(AnOrder.Text));
46 LoadWardComments(memComments.Lines, AnOrder.ID);
47 ShowModal;
48 if OKPressed then
49 begin
50 PutWardComments(memComments.Lines, AnOrder.ID, ErrMsg);
51 if Length(ErrMsg) > 0 then InfoBox(ErrMsg, TC_PUT_ERR, MB_OK);
52 Result := True;
53 end;
54 end;
55 finally
56 frmWardComments.Release;
57 end;
58end;
59
60procedure TfrmWardComments.FormCreate(Sender: TObject);
61begin
62 inherited;
63 OKPressed := False;
64end;
65
66procedure TfrmWardComments.cmdOKClick(Sender: TObject);
67begin
68 inherited;
69 OKPressed := True;
70 Close;
71end;
72
73procedure TfrmWardComments.cmdCancelClick(Sender: TObject);
74begin
75 inherited;
76 Close;
77end;
78
79procedure TfrmWardComments.memCommentsKeyUp(Sender: TObject; var Key: Word;
80 Shift: TShiftState);
81begin
82 inherited;
83 if (Key = VK_TAB) then
84 begin
85 if ssShift in Shift then
86 begin
87 FindNextControl(Sender as TWinControl, False, True, False).SetFocus; //previous control
88 Key := 0;
89 end
90 else if ssCtrl in Shift then
91 begin
92 FindNextControl(Sender as TWinControl, True, True, False).SetFocus; //next control
93 Key := 0;
94 end;
95 end;
96 if (key = VK_ESCAPE) then begin
97 FindNextControl(Sender as TWinControl, False, True, False).SetFocus; //previous control
98 key := 0;
99 end;
100end;
101
102end.
Note: See TracBrowser for help on using the repository browser.