| [541] | 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 | 
 | 
|---|