unit fPatientFlagMulti; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, fAutoSz, ORCtrls, ExtCtrls, ComCtrls, rMisc; type TfrmFlags = class(TfrmAutoSz) Splitter1: TSplitter; Panel1: TPanel; btnClose: TButton; Panel2: TPanel; lblFlags: TLabel; lstFlags: TORListBox; memFlags: TCaptionMemo; procedure lstFlagsClick(Sender: TObject); procedure btnCloseClick(Sender: TObject); procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure FormShow(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); private FFlagID: integer; public { Public declarations } end; procedure ShowFlags(FlagId: integer = 0); implementation uses uCore,uOrPtf,ORFn; {$R *.dfm} procedure ShowFlags(FlagId: integer); var frmFlags: TfrmFlags; begin frmFlags := TFrmFlags.Create(Nil); try SetFormPosition(frmFlags); if HasFlag then begin SetFormPosition(frmFlags); frmFlags.FFlagID := FlagId; frmFlags.lstFlags.Items.Assign(FlagList); frmFlags.memFlags.SelStart := 0; //ResizeFormToFont(TForm(frmFlags)); frmFlags.ShowModal; end finally frmFlags.Release; end; end; procedure TfrmFlags.lstFlagsClick(Sender: TObject); var FlagArray: TStringList; begin if lstFlags.ItemIndex >= 0 then begin FlagArray := TStringList.Create; GetActiveFlg(FlagArray, Patient.DFN, lstFlags.ItemID); if FlagArray.Count > 0 then memFlags.Lines.Assign(FlagArray); memFlags.SelStart := 0; end; end; procedure TfrmFlags.btnCloseClick(Sender: TObject); begin Close; end; procedure TfrmFlags.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if Key = VK_ESCAPE then Close; end; procedure TfrmFlags.FormShow(Sender: TObject); var idx: integer; begin inherited; idx := 0; if FFlagID > 0 then idx := lstFlags.SelectByIEN(FFlagId); lstFlags.ItemIndex := idx; lstFlagsClick(Self); ActiveControl := memFlags; end; procedure TfrmFlags.FormCreate(Sender: TObject); begin inherited; FFlagID := 0; end; procedure TfrmFlags.FormClose(Sender: TObject; var Action: TCloseAction); begin inherited; //SaveUserBounds(Self); end; end.