//kt -- Modified with SourceScanner on 8/8/2007 unit fPreReq; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ORFn, ComCtrls, ExtCtrls, DKLang; type TfrmPrerequisites = class(TForm) lblFontTest: TLabel; memReport: TRichEdit; pnlButton: TPanel; cmdContinue: TButton; cmdCancel: TButton; cmdPrint: TButton; dlgPrintReport: TPrintDialog; DKLanguageController1: TDKLanguageController; procedure memReportClick(Sender: TObject); procedure cmdContinueClick(Sender: TObject); procedure cmdCancelClick(Sender: TObject); procedure cmdPrintClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure FormShow(Sender: TObject); private procedure AlignButtons(); end; function DisplayPrerequisites(ReportText: TStrings; ReportTitle: string): Boolean; var ContinueWithOrder: Boolean; implementation uses uCore, rCore, rReports, Printers,rMisc; {$R *.DFM} function CreateReportBox(ReportText: TStrings; ReportTitle: string): TfrmPrerequisites; var i, AWidth, MaxWidth, AHeight: Integer; Rect: TRect; begin Result := TfrmPrerequisites.Create(Application); try with Result do begin MaxWidth := PnlButton.Width; for i := 0 to ReportText.Count - 1 do begin AWidth := lblFontTest.Canvas.TextWidth(ReportText[i]); if AWidth > MaxWidth then MaxWidth := AWidth; end; MaxWidth := MaxWidth + (GetSystemMetrics(SM_CXFRAME) * 2) + GetSystemMetrics(SM_CXVSCROLL); AHeight := (ReportText.Count * lblFontTest.Height) + ReportText.Count + (GetSystemMetrics(SM_CYFRAME) * 3) + GetSystemMetrics(SM_CYCAPTION); AHeight := AHeight + pnlbutton.Height; AHeight := HigherOf(AHeight, 250); if AHeight > (Screen.Height - 60) then AHeight := Screen.Height - 60; if MaxWidth > Screen.Width then MaxWidth := Screen.Width; Width := MaxWidth; Height := AHeight; Rect := BoundsRect; ForceInsideWorkArea(Rect); BoundsRect := Rect; memReport.Lines.Assign(ReportText); ResizeAnchoredFormToFont(result); //Quick fix to work around glich in resize algorithim AlignButtons(); for i := 1 to Length(ReportTitle) do if ReportTitle[i] = #9 then ReportTitle[i] := ' '; Caption := ReportTitle; memReport.SelStart := 0; end; except KillObj(@Result); raise; end; end; function DisplayPrerequisites(ReportText: TStrings; ReportTitle: string): Boolean; var frmPrerequisites: TfrmPrerequisites; begin frmPrerequisites := CreateReportBox(ReportText, ReportTitle); try frmPrerequisites.ShowModal; Result := ContinueWithOrder; finally frmPrerequisites.Release; end; end; procedure TfrmPrerequisites.memReportClick(Sender: TObject); begin //Close; end; procedure TfrmPrerequisites.cmdContinueClick(Sender: TObject); begin ContinueWithOrder := True; Close; end; procedure TfrmPrerequisites.cmdCancelClick(Sender: TObject); begin ContinueWithOrder := False; Close; end; procedure TfrmPrerequisites.cmdPrintClick(Sender: TObject); var AHeader: TStringList; memPrintReport: TRichEdit; MaxLines, LastLine, ThisPage, i: integer; ErrMsg: string; RemoteSiteID: string; //for Remote site printing RemoteQuery: string; //for Remote site printing const PAGE_BREAK = '**PAGE BREAK**'; begin RemoteSiteID := ''; RemoteQuery := ''; if dlgPrintReport.Execute then begin AHeader := TStringList.Create; CreatePatientHeader(AHeader, Self.Caption); memPrintReport := TRichEdit.Create(Self); try MaxLines := 60 - AHeader.Count; LastLine := 0; ThisPage := 0; with memPrintReport do begin Visible := False; Parent := Self; Font.Name := 'Courier New'; Font.Size := MainFontSize; Width := Printer.Canvas.TextWidth(StringOfChar('-', 74)); //Width := 600; repeat with Lines do begin AddStrings(AHeader); for i := 0 to MaxLines do if i < memReport.Lines.Count then Add(memReport.Lines[LastLine + i]) else Break; LastLine := LastLine + i; Add(' '); Add(' '); Add(StringOfChar('-', 74)); if LastLine >= memReport.Lines.Count - 1 then // Add('End of report') <-- original line. //kt 8/8/2007 Add(DKLangConstW('fPreReq_End_of_report')) //kt else begin ThisPage := ThisPage + 1; // Add('Page ' + IntToStr(ThisPage)); <-- original line. //kt 8/8/2007 Add(DKLangConstW('fPreReq_Page') + IntToStr(ThisPage)); //kt Add(PAGE_BREAK); end; end; until LastLine >= memReport.Lines.Count - 1; PrintWindowsReport(memPrintReport, PAGE_BREAK, Self.Caption, ErrMsg); end; finally memPrintReport.Free; AHeader.Free; end; end; memReport.SelStart := 0; memReport.Invalidate; end; procedure TfrmPrerequisites.FormCreate(Sender: TObject); begin memreport.Color := ReadOnlyColor; end; procedure TfrmPrerequisites.AlignButtons; Const BtnSpace = 8; begin cmdCancel.Left := self.Width - cmdCancel.Width - BtnSpace; cmdContinue.Left := cmdCancel.Left - BtnSpace - cmdContinue.Width; end; procedure TfrmPrerequisites.FormClose(Sender: TObject; var Action: TCloseAction); begin SaveUserBounds(Self); //Save Position & Size of Form end; procedure TfrmPrerequisites.FormShow(Sender: TObject); begin SetFormPosition(Self); //Get Saved Position & Size of Form end; end.