| 1 | unit FMErrorU; | 
|---|
| 2 | (* | 
|---|
| 3 | WorldVistA Configuration Utility | 
|---|
| 4 | (c) 8/2008 Kevin Toppenberg | 
|---|
| 5 | Programmed by Kevin Toppenberg, Eddie Hagood | 
|---|
| 6 |  | 
|---|
| 7 | Family Physicians of Greeneville, PC | 
|---|
| 8 | 1410 Tusculum Blvd, Suite 2600 | 
|---|
| 9 | Greeneville, TN 37745 | 
|---|
| 10 | kdtop@yahoo.com | 
|---|
| 11 |  | 
|---|
| 12 | This library is free software; you can redistribute it and/or | 
|---|
| 13 | modify it under the terms of the GNU Lesser General Public | 
|---|
| 14 | License as published by the Free Software Foundation; either | 
|---|
| 15 | version 2.1 of the License, or (at your option) any later version. | 
|---|
| 16 |  | 
|---|
| 17 | This library is distributed in the hope that it will be useful, | 
|---|
| 18 | but WITHOUT ANY WARRANTY; without even the implied warranty of | 
|---|
| 19 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU | 
|---|
| 20 | Lesser General Public License for more details. | 
|---|
| 21 |  | 
|---|
| 22 | You should have received a copy of the GNU Lesser General Public | 
|---|
| 23 | License along with this library; if not, write to the Free Software | 
|---|
| 24 | Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA | 
|---|
| 25 | *) | 
|---|
| 26 |  | 
|---|
| 27 | interface | 
|---|
| 28 |  | 
|---|
| 29 | uses | 
|---|
| 30 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, | 
|---|
| 31 | Dialogs, StdCtrls; | 
|---|
| 32 |  | 
|---|
| 33 | type | 
|---|
| 34 | TFMErrorForm = class(TForm) | 
|---|
| 35 | Memo: TMemo; | 
|---|
| 36 | OKBtn: TButton; | 
|---|
| 37 | private | 
|---|
| 38 | { Private declarations } | 
|---|
| 39 | public | 
|---|
| 40 | { Public declarations } | 
|---|
| 41 | procedure PrepMessage; | 
|---|
| 42 | end; | 
|---|
| 43 |  | 
|---|
| 44 | var | 
|---|
| 45 | FMErrorForm: TFMErrorForm; | 
|---|
| 46 |  | 
|---|
| 47 | implementation | 
|---|
| 48 |  | 
|---|
| 49 | {$R *.dfm} | 
|---|
| 50 |  | 
|---|
| 51 | uses | 
|---|
| 52 | ORFn, StrUtils; | 
|---|
| 53 |  | 
|---|
| 54 | procedure TFMErrorForm.PrepMessage; | 
|---|
| 55 | var | 
|---|
| 56 | text : string; | 
|---|
| 57 | begin | 
|---|
| 58 |  | 
|---|
| 59 | if Memo.Lines.Count=1 then begin | 
|---|
| 60 | if piece(Memo.Lines.Strings[0],'^',1)='-1' then begin | 
|---|
| 61 | Memo.Lines.Strings[0] := piece(Memo.Lines.Strings[0],'^',2); | 
|---|
| 62 | end; | 
|---|
| 63 | end else if Memo.Lines.Count>1 then begin | 
|---|
| 64 | if piece(Memo.Lines.Strings[0],'^',1)='-1' then begin | 
|---|
| 65 | Memo.Lines.Delete(0); | 
|---|
| 66 | text := Memo.Lines.Text; | 
|---|
| 67 | text := AnsiReplaceStr(text, ' [', #13+'['); | 
|---|
| 68 | text := AnsiReplaceStr(text, 'Fileman says:', 'Database error message:'+#13); | 
|---|
| 69 | Memo.Lines.Text := text; | 
|---|
| 70 | end; | 
|---|
| 71 | end; | 
|---|
| 72 | end; | 
|---|
| 73 |  | 
|---|
| 74 | end. | 
|---|
| 75 |  | 
|---|