Context Navigation

source: cprs/branches/tmg-cprs/CPRS-Chart/Options/fOptions.pas@ 489

Last change on this file since 489 was 489, checked in by Kevin Toppenberg, 16 years ago
Adding skin support
File size: 34.0 KB

Rev	Line
[453]	1	//kt -- Modified with SourceScanner on 8/8/2007
	2	unit fOptions;
	3
	4	interface
	5
[487]	6	uses
	7	Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
[453]	8	Buttons, ComCtrls, ExtCtrls, ORCtrls, OrFn, Dialogs, ORDtTmRng, fBAOptionsDiagnoses,
	9	uBAGlobals, TntStdCtrls, DKLang, jpeg, inifiles;
	10
	11	//kt added 6/29/07 ------------------
	12	{Note: an additional tab was added to form: tsLanguage, with caption "Language"
	13	It contained a combo box (TTntComboxBox to support unicode language display)
	14	It has an on change event added below. There was a memo field describing
	15	how adding languages works:
	16
	17	For a given language to be available, a *.lng (e.g. spanish.lng) must be in the
	18	same directory as CPRSchart.exe. *.lng may be created by users by working
	19	with the CPRSchart.dklng file with the free language editor found at:
	20	http://www.dk-soft.org/products/dklang/
	21
	22	Note: Cancel for language change is not currently supported
[487]	23	//kt 9/8/08 ----------------------------
	24	Also, a tab was added to the form: Appearance, for selecting skins.
[453]	25	}
	26
	27	type
	28	TfrmOptions = class(TForm)
	29	pnlMain: TPanel;
	30	pnlBottom: TPanel;
	31	pagOptions: TPageControl;
	32	tsCoverSheet: TTabSheet;
	33	tsNotifications: TTabSheet;
	34	btnOK: TButton;
	35	btnCancel: TButton;
	36	btnApply: TButton;
	37	tsOrderChecks: TTabSheet;
	38	tsListsTeams: TTabSheet;
	39	tsLanguage: TTabSheet; //kt added 6/29/07 (added in form editor)
	40	lblCoverReminderDesc: TMemo;
	41	lblCoverReminders: TStaticText;
	42	lblCoverDaysDesc: TMemo;
	43	lblCoverDays: TStaticText;
	44	btnCoverDays: TButton;
	45	bvlCoverDays: TBevel;
	46	btnCoverReminders: TButton;
	47	bvlCoverReminders: TBevel;
	48	imgCoverDays: TImage;
	49	imgCoverReminders: TImage;
	50	lblPatientSelectionDesc: TMemo;
	51	lblPatientSelection: TStaticText;
	52	btnPatientSelection: TButton;
	53	bvlPatientSelection: TBevel;
	54	btnPersonalLists: TButton;
	55	imgPatientSelection: TImage;
	56	lblNotificationsOptions: TStaticText;
	57	lblNotifications: TStaticText;
	58	bvlNotifications: TBevel;
	59	imgNotifications: TImage;
	60	lblOrderChecksDesc: TLabel;
	61	lblOrderChecks: TStaticText;
	62	bvlOrderChecks: TBevel;
	63	imgOrderChecks: TImage;
	64	lblTeamsDesc: TMemo;
	65	lblTeams: TStaticText;
	66	btnTeams: TButton;
	67	bvlTeams: TBevel;
	68	lvwNotifications: TCaptionListView;
	69	lblNotificationView: TLabel;
	70	btnNotificationsRemove: TButton;
	71	chkNotificationsFlagged: TCheckBox;
	72	lvwOrderChecks: TCaptionListView;
	73	lblOrderChecksView: TLabel;
	74	btnSurrogate: TButton;
	75	lblNotificationsSurrogate: TStaticText;
	76	lblNotificationsSurrogateText: TStaticText;
	77	btnCombinations: TButton;
	78	bvlOtherParameters: TBevel;
	79	lblOtherParameters: TStaticText;
	80	imgOtherParameters: TImage;
	81	lblOtherParametersDesc: TMemo;
	82	btnOtherParameters: TButton;
	83	tsNotes: TTabSheet;
	84	lblNotesNotesDesc: TMemo;
	85	lblNotesNotes: TStaticText;
	86	bvlNotesNotes: TBevel;
	87	btnNotesNotes: TButton;
	88	lblNotesTitles: TStaticText;
	89	bvlNotesTitles: TBevel;
	90	lblNotesTitlesDesc: TMemo;
	91	btnNotesTitles: TButton;
	92	imgNotesNotes: TImage;
	93	imgNotes: TImage;
	94	imgTeams: TImage;
	95	tsCprsReports: TTabSheet;
	96	lblReports: TStaticText;
	97	bvlReports: TBevel;
	98	memReports: TMemo;
	99	imgReports: TImage;
	100	btnReports: TButton;
	101	lblReport1: TStaticText;
	102	memReport1: TMemo;
	103	btnReport1: TButton;
	104	bvlReport1: TBevel;
	105	btnDiagnoses: TButton;
	106	tsGraphs: TTabSheet;
	107	lblGraphSettings: TStaticText;
	108	bvlGraphSettings: TBevel;
	109	imgGraphSettings: TImage;
	110	btnGraphSettings: TButton;
	111	bvlGraphViews: TBevel;
	112	lblGraphViews: TStaticText;
	113	imgGraphViews: TImage;
	114	btnGraphViews: TButton;
	115	memGraphSettings: TMemo;
	116	memGraphViews: TMemo;
	117	bvlReport2: TBevel;
	118	lblReport2: TStaticText;
	119	memReport2: TMemo;
	120	imgReport1: TImage;
	121	imgReport2: TImage;
	122	rdoRDV: TRadioGroup;
	123	cbLanguage: TTntComboBox;
	124	Label1: TLabel;
	125	Label2: TLabel;
	126	DKLanguageController1: TDKLanguageController;
	127	Image1: TImage;
	128	Memo1: TMemo;
	129	Button1: TButton;
[487]	130	tsAppearance: TTabSheet;
	131	Label12: TLabel;
	132	lbSkins: TListBox;
	133	cbSkinAtStartup: TCheckBox;
	134	btnMoreSkins: TButton;
	135	btnDisableSkin: TButton;
	136	btnApplySkin: TButton;
[453]	137	procedure FormCreate(Sender: TObject);
	138	procedure FormDestroy(Sender: TObject);
	139	procedure btnCoverDaysClick(Sender: TObject);
	140	procedure btnCoverRemindersClick(Sender: TObject);
	141	procedure btnOtherParametersClick(Sender: TObject);
	142	procedure btnPatientSelectionClick(Sender: TObject);
	143	procedure btnPersonalListsClick(Sender: TObject);
	144	procedure btnTeamsClick(Sender: TObject);
	145	procedure btnNotificationsRemoveClick(Sender: TObject);
	146	procedure btnApplyClick(Sender: TObject);
	147	procedure chkNotificationsFlaggedClick(Sender: TObject);
	148	procedure lvwNotificationsChange(Sender: TObject; Item: TListItem;
	149	Change: TItemChange);
	150	procedure lvwNotificationsColumnClick(Sender: TObject;
	151	Column: TListColumn);
	152	procedure lvwNotificationsCompare(Sender: TObject; Item1,
	153	Item2: TListItem; Data: Integer; var Compare: Integer);
	154	procedure lvwNotificationsDblClick(Sender: TObject);
	155	procedure btnSurrogateClick(Sender: TObject);
	156	procedure btnCombinationsClick(Sender: TObject);
	157	procedure btnNotesNotesClick(Sender: TObject);
	158	procedure btnNotesTitlesClick(Sender: TObject);
	159	procedure btnReportsClick(Sender: TObject);
	160	procedure btnReport1Click(Sender: TObject);
	161	procedure lvwNotificationsEnter(Sender: TObject);
	162	procedure lvwNotificationsMouseDown(Sender: TObject;
	163	Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
	164	procedure btnDiagnosesClick(Sender: TObject);
	165	procedure btnGraphSettingsClick(Sender: TObject);
	166	procedure btnGraphViewsClick(Sender: TObject);
	167	procedure rdoRDVClick(Sender: TObject);
	168	procedure cbLanguageChange(Sender: TObject);
[487]	169	procedure Button1Click(Sender: TObject);
	170	procedure btnApplySkinClick(Sender: TObject);
	171	procedure btnMoreSkinsClick(Sender: TObject);
	172	procedure FormShow(Sender: TObject);
	173	procedure lbSkinsKeyPress(Sender: TObject; var Key: Char);
	174	procedure btnDisableSkinClick(Sender: TObject); //kt added 6/29/07
[453]	175	private
	176	{ Private declarations }
	177	FdirtyNotifications: boolean; // used to determine edit changes to Notifications
	178	FdirtyOrderChecks: boolean; // used to determine edit changes to Order Checks
	179	FdirtyOtherStuff: boolean; // used to determine edit changes to misc settings
	180	FuseCheckBoxes: boolean;
	181	FsortCol: integer;
	182	FsortAscending: boolean;
	183	FLastClickedItem: TListItem;
[487]	184	procedure FillSkinList; //kt
[453]	185	procedure Offset(var topnum: integer; topoffset: integer; var leftnum: integer; leftoffset: integer);
	186	procedure LoadNotifications;
	187	procedure LoadOrderChecks;
	188	procedure ApplyNotifications;
	189	procedure ApplyOrderChecks;
	190	procedure ApplyOtherStuff;
	191	procedure CheckApply;
	192	procedure LoadListView(aListView: TListView; aList: TStrings);
	193	procedure ChangeOnOff(aListView: TListView; aListItem: TListItem);
	194	public
	195	{ Public declarations }
	196	end;
	197
	198	var
	199	frmOptions: TfrmOptions;
	200
	201	procedure DialogOptions(var actiontype: Integer);
	202
	203	implementation
	204
[487]	205	uses fOptionsDays, fOptionsReminders, fOptionsSurrogate,
	206	fOptionsPatientSelection, fOptionsLists, fOptionsTeams, fOptionsCombinations,
	207	fOptionsOther, fOptionsNotes, fOptionsTitles, fOptionsReportsCustom, fOptionsReportsDefault,
	208	fGraphs, fGraphSettings, fGraphProfiles, rGraphs, uGraphs,
	209	rOptions, rCore, uCore, uOptions, UBACore, fFrame,
	210	//fTestDialog;
[453]	211
	212	//kt mod 6/29/07 -----
[487]	213	ShellAPI, //kt 9/8/08
[453]	214	ORNet, //allows access to RPCBrokerV
	215	TntForms, TntSystem, TntSysUtils;
	216	//kt end mod ---------
	217
	218
	219	{$R *.DFM}
	220
[487]	221	type
	222	TRule = class
	223	public
	224	IEN: string;
	225	OriginalValue: string;
	226	ItemText: string;
	227	end;
[453]	228
[487]	229	procedure DialogOptions(var actiontype: Integer);
	230	// create the form and make in modal, return an action
	231	const
	232	PixelGapBetweenButtons = 5;
	233	var
	234	frmOptions: TfrmOptions;
	235	begin
	236	frmOptions := TfrmOptions.Create(Application);
	237	try
	238	with frmOptions do
[453]	239	begin
[487]	240	with pagOptions do
	241	begin
	242	tsCoverSheet.TabVisible := false;
	243	tsNotifications.TabVisible := false;
	244	tsOrderChecks.TabVisible := false;
	245	tsListsTeams.TabVisible := false;
	246	case actiontype of
	247	1: begin
	248	tsCoverSheet.TabVisible := true;
	249	end;
	250	2: begin
	251	tsNotifications.TabVisible := true;
	252	end;
	253	3: begin
	254	tsOrderChecks.TabVisible := true;
	255	end;
	256	4: begin
	257	tsListsTeams.TabVisible := true;
	258	end;
	259	else
	260	begin
	261	tsCoverSheet.TabVisible := true;
	262	tsNotifications.TabVisible := true;
	263	tsOrderChecks.TabVisible := true;
	264	tsListsTeams.TabVisible := true;
	265	ActivePage := tsCoverSheet;
	266	// memReports.Text := 'Change the default date range and occurrence limits for all reports on ' + <-- original line. //kt 8/8/2007
	267	memReports.Text := DKLangConstW('fOptions_Change_the_default_date_range_and_occurrence_limits_for_all_reports_on') + //kt added 8/8/2007
	268	// 'the CPRS Reports tab (excluding health summary reports) .'; <-- original line. //kt 8/8/2007
	269	DKLangConstW('fOptions_the_CPRS_Reports_tab_xexcluding_health_summary_reportsx_x'); //kt added 8/8/2007
	270	// memReport1.Text := 'Change the individual date range and occurrence limits for each report on ' + <-- original line. //kt 8/8/2007
	271	memReport1.Text := DKLangConstW('fOptions_Change_the_individual_date_range_and_occurrence_limits_for_each_report_on') + //kt added 8/8/2007
	272	// 'the CPRS Reports tab (excluding health summary reports) .'; <-- original line. //kt 8/8/2007
	273	DKLangConstW('fOptions_the_CPRS_Reports_tab_xexcluding_health_summary_reportsx_x'); //kt added 8/8/2007
	274	// btnReports.caption := 'Set All Reports...'; <-- original line. //kt 8/8/2007
	275	btnReports.caption := DKLangConstW('fOptions_Set_All_Reportsxxx'); //kt added 8/8/2007
	276	// btnReport1.caption := 'Set Individual Reports...'; <-- original line. //kt 8/8/2007
	277	btnReport1.caption := DKLangConstW('fOptions_Set_Individual_Reportsxxx'); //kt added 8/8/2007
	278	if User.IsReportsOnly then // For "Reports Only" users.
[453]	279	begin
[487]	280	tsCoverSheet.TabVisible := false;
	281	tsNotifications.TabVisible := false;
	282	tsOrderChecks.TabVisible := false;
	283	tsListsTeams.TabVisible := false;
	284	tsNotes.TabVisible := false;
	285	if (not User.ToolsRptEdit) then
	286	begin
	287	btnOK.visible := false;
	288	btnApply.visible := false;
	289	// btnCancel.caption := 'Close'; <-- original line. //kt 8/8/2007
	290	btnCancel.caption := DKLangConstW('fOptions_Close'); //kt added 8/8/2007
	291	end;
[453]	292	end;
[487]	293	if (not User.ToolsRptEdit) then // For users with Reports settings edit parameter not set.
	294	begin
	295	// memReports.Text := 'View the default date range and occurrence limits for all reports on ' + <-- original line. //kt 8/8/2007
	296	memReports.Text := DKLangConstW('fOptions_View_the_default_date_range_and_occurrence_limits_for_all_reports_on') + //kt added 8/8/2007
	297	// 'the CPRS Reports tab (excluding health summary reports) .'; <-- original line. //kt 8/8/2007
	298	DKLangConstW('fOptions_the_CPRS_Reports_tab_xexcluding_health_summary_reportsx_x'); //kt added 8/8/2007
	299	// memReport1.Text := 'View the individual date range and occurrence limits for each report on ' + <-- original line. //kt 8/8/2007
	300	memReport1.Text := DKLangConstW('fOptions_View_the_individual_date_range_and_occurrence_limits_for_each_report_on') + //kt added 8/8/2007
	301	// 'the CPRS Reports tab (excluding health summary reports) .'; <-- original line. //kt 8/8/2007
	302	DKLangConstW('fOptions_the_CPRS_Reports_tab_xexcluding_health_summary_reportsx_x'); //kt added 8/8/2007
	303	// btnReports.caption := 'View All Report Settings...'; <-- original line. //kt 8/8/2007
	304	btnReports.caption := DKLangConstW('fOptions_View_All_Report_Settingsxxx'); //kt added 8/8/2007
	305	// btnReport1.caption := 'View Individual Report Settings...'; <-- original line. //kt 8/8/2007
	306	btnReport1.caption := DKLangConstW('fOptions_View_Individual_Report_Settingsxxx'); //kt added 8/8/2007
	307	end;
	308	end;
	309	end;
[453]	310	end;
[487]	311	actiontype := 0;
	312	ResizeAnchoredFormToFont(frmOptions);
	313	btnApply.Left := pagOptions.Left + pagOptions.Width - btnApply.Width;
	314	btnCancel.Left := btnApply.Left - btnCancel.Width - PixelGapBetweenButtons;
	315	btnOK.Left := btnCancel.Left - btnOK.Width - PixelGapBetweenButtons;
	316	ShowModal;
	317	actiontype := btnOK.Tag;
[453]	318	end;
[487]	319	finally
	320	frmOptions.Release;
[453]	321	end;
	322	end;
	323
[487]	324	procedure TfrmOptions.FormCreate(Sender: TObject);
	325	// initialize form
	326	var i : integer; //kt added 6/29/07
	327	begin
	328	LoadNotifications;
	329	LoadOrderChecks;
	330	FdirtyNotifications := false;
	331	FdirtyOrderChecks := false;
	332	FdirtyOtherStuff := false;
	333	CheckApply;
[453]	334
[487]	335	if (Encounter.Provider = 0) and not IsCIDCProvider(User.DUZ) then
	336	btnDiagnoses.Enabled := False;
	337	if UseVistaWeb then rdoRDV.ItemIndex := 1;
[453]	338
[487]	339	//kt begin modification 6/29/07 ---------------
[453]	340
[487]	341	// Fill cbLanguage with available languages
	342	// Note: LangManager was populated at form creation of fFrame
	343	for i := 0 to LangManager.LanguageCount-1 do cbLanguage.Items.Add(LangManager.LanguageNames[i]);
	344	//Index=0 always means the default language
	345	cbLanguage.ItemIndex := LangManager.LanguageIndex;
	346	//kt end modification 6/29/07 ---------------
[453]	347
[487]	348	cbSkinAtStartup.Checked := frmFrame.SkinAtStartup; //kt 9/8/08
[453]	349
[487]	350	end;
[453]	351
[487]	352	procedure TfrmOptions.FormDestroy(Sender: TObject);
	353	// cleanup creation of objects
	354	var
	355	i: integer;
	356	begin
	357	for i := 0 to lvwOrderChecks.Items.Count - 1 do
	358	lvwOrderChecks.Items.Item[i].SubItems.Objects[2].free;
	359	for i := 0 to lvwNotifications.Items.Count - 1 do
	360	lvwNotifications.Items.Item[i].SubItems.Objects[2].free;
	361	end;
[453]	362
[487]	363	procedure TfrmOptions.btnCoverDaysClick(Sender: TObject);
	364	// display Date Range Defaults on Cover Sheet
	365	var
	366	topsize, leftsize, value: integer;
	367	begin
	368	value := 0;
	369	Offset(topsize, -60, leftsize, -60);
	370	DialogOptionsDays(topsize, leftsize, Font.Size, value);
	371	end;
[453]	372
[487]	373	procedure TfrmOptions.btnCoverRemindersClick(Sender: TObject);
	374	// display Clinical Reminder Options
	375	var
	376	topsize, leftsize, value: integer;
	377	begin
	378	value := 0;
	379	Offset(topsize, -60, leftsize, -60);
	380	DialogOptionsReminders(topsize, leftsize, Font.Size, value);
	381	end;
[453]	382
[487]	383	procedure TfrmOptions.btnOtherParametersClick(Sender: TObject);
	384	// display Other Parameters Options
	385	var
	386	topsize, leftsize, value: integer;
	387	begin
	388	value := 0;
	389	Offset(topsize, 40, leftsize, 40);
	390	DialogOptionsOther(topsize, leftsize, Font.Size, value);
	391	end;
[453]	392
[487]	393	procedure TfrmOptions.btnPatientSelectionClick(Sender: TObject);
	394	// display Patient Selection Options
	395	var
	396	topsize, leftsize, value: integer;
	397	begin
	398	value := 0;
	399	Offset(topsize, -60, leftsize, -60);
	400	DialogOptionsPatientSelection(topsize, leftsize, Font.Size, value);
	401	end;
[453]	402
[487]	403	procedure TfrmOptions.btnPersonalListsClick(Sender: TObject);
	404	// display Personal Lists Options
	405	var
	406	topsize, leftsize, value: integer;
	407	begin
	408	value := 0;
	409	Offset(topsize, -60, leftsize, -60);
	410	DialogOptionsLists(topsize, leftsize, Font.Size, value);
	411	end;
[453]	412
[487]	413	procedure TfrmOptions.btnTeamsClick(Sender: TObject);
	414	// display Team Options
	415	var
	416	topsize, leftsize, value: integer;
	417	begin
	418	value := 0;
	419	Offset(topsize, -60, leftsize, -60);
	420	DialogOptionsTeams(topsize, leftsize, Font.Size, value);
	421	end;
[453]	422
[487]	423	procedure TfrmOptions.btnNotificationsRemoveClick(Sender: TObject);
	424	// confirm before clearing notifications
	425	begin
	426	//if InfoBox('CAUTION: This will clear all the current notifications you have pending.' <-- original line. //kt 8/8/2007
	427	if InfoBox(DKLangConstW('fOptions_CAUTIONx_This_will_clear_all_the_current_notifications_you_have_pendingx') //kt added 8/8/2007
	428	// + #13 + 'If you say YES, these changes will take place immediately.' <-- original line. //kt 8/8/2007
	429	+ #13 + DKLangConstW('fOptions_If_you_say_YESx_these_changes_will_take_place_immediatelyx') //kt added 8/8/2007
	430	// + #13 + 'Are you sure you want to erase all of your notifications?', <-- original line. //kt 8/8/2007
	431	+ #13 + DKLangConstW('fOptions_Are_you_sure_you_want_to_erase_all_of_your_notificationsx'), //kt added 8/8/2007
	432	// 'Warning', MB_YESNO or MB_ICONWARNING) = IDYES then <-- original line. //kt 8/8/2007
	433	DKLangConstW('fOptions_Warning'), MB_YESNO or MB_ICONWARNING) = IDYES then //kt added 8/8/2007
	434	begin
	435	rpcClearNotifications;
	436	end;
	437	end;
[453]	438
[487]	439	procedure TfrmOptions.Offset(var topnum: integer; topoffset: integer; var leftnum: integer; leftoffset: integer);
	440	// get positions to display dialog
	441	begin
	442	// use these top and left values to display dialog
	443	topnum := Top;
	444	leftnum := Left;
	445	topnum := topnum + topoffset;
	446	if topnum < 0 then topnum := 0;
	447	leftnum := leftnum + leftoffset;
	448	if leftnum < 0 then leftnum := 0;
	449	end;
[453]	450
[487]	451	procedure TfrmOptions.btnApplyClick(Sender: TObject);
	452	// save actions without exiting
	453	begin
	454	if FdirtyNotifications then
	455	ApplyNotifications;
	456	if FdirtyOrderChecks then
	457	ApplyOrderChecks;
	458	if FdirtyOtherStuff then
	459	ApplyOtherStuff;
	460	CheckApply;
	461	if Sender = btnOK then
	462	Close;
	463	end;
[453]	464
[487]	465	procedure TfrmOptions.LoadNotifications;
	466	// load Notification tab
	467	var
	468	notifydefaults, surrogateinfo, flag, enableerase: string;
	469	begin
	470	LoadListView(lvwNotifications, rpcGetNotifications);
	471	lvwNotificationsColumnClick(lvwNotifications, lvwNotifications.Column[0]); // make sure sorted
	472	notifydefaults := rpcGetNotificationDefaults;
	473	flag := Piece(notifydefaults, '^', 2);
	474	enableerase := Piece(notifydefaults, '^', 3);
	475	chkNotificationsFlagged.Checked := flag = '1';
	476	btnNotificationsRemove.Enabled := enableerase = '1';
	477	surrogateinfo := rpcGetSurrogateInfo;
	478	btnSurrogate.Hint := surrogateinfo;
	479	LabelSurrogate(surrogateinfo, lblNotificationsSurrogateText);
	480	end;
[453]	481
[487]	482	procedure TfrmOptions.LoadOrderChecks;
	483	// load Order Check tab
	484	begin
	485	LoadListView(lvwOrderChecks, rpcGetOrderChecks);
	486	lvwOrderChecks.Checkboxes := true;
	487	end;
[453]	488
[487]	489	procedure TfrmOptions.ApplyNotifications;
	490	// save Notification changes
	491	var
	492	i: integer;
	493	newonoff: string;
	494	aRule: TRule;
	495	aList: TStringList;
	496	begin
	497	aList := TStringList.Create;
	498	for i := 0 to lvwNotifications.Items.Count - 1 do
	499	begin
	500	aRule := TRule(lvwNotifications.Items.Item[i].SubItems.Objects[2]);
	501	// if lvwNotifications.Items.Item[i].SubItems[1] <> 'Mandatory' then <-- original line. //kt 8/8/2007
	502	if lvwNotifications.Items.Item[i].SubItems[1] <> DKLangConstW('fOptions_Mandatory') then //kt added 8/8/2007
	503	begin
	504	newonoff := Uppercase(lvwNotifications.Items.Item[i].SubItems[0]);
	505	if aRule.OriginalValue <> newonoff then
	506	begin
	507	//***showmessage(aRule.IEN + ' ' + aRule.OriginalValue + ' ' + newonoff);
	508	aList.Add(aRule.IEN + '^' + newonoff);
	509	aRule.OriginalValue := lvwNotifications.Items.Item[i].SubItems[0];
	510	end;
	511	end;
	512	end;
	513	rpcSetNotifications(aList);
	514	aList.free;
	515	FdirtyNotifications := false;
	516	end;
[453]	517
[487]	518	procedure TfrmOptions.ApplyOrderChecks;
	519	// save Order Check changes
	520	var
	521	i: integer;
	522	newonoff: string;
	523	aRule: TRule;
	524	aList: TStringList;
[453]	525	begin
[487]	526	aList := TStringList.Create;
	527	for i := 0 to lvwOrderChecks.Items.Count - 1 do
[453]	528	begin
[487]	529	aRule := TRule(lvwOrderChecks.Items.Item[i].SubItems.Objects[2]);
	530	newonoff := Uppercase(lvwOrderChecks.Items.Item[i].SubItems[0]);
[453]	531	if aRule.OriginalValue <> newonoff then
	532	begin
	533	aList.Add(aRule.IEN + '^' + newonoff);
[487]	534	aRule.OriginalValue := lvwOrderChecks.Items.Item[i].SubItems[0];
[453]	535	end;
	536	end;
[487]	537	rpcSetOrderChecks(aList);
	538	aList.free;
	539	FdirtyOrderChecks := false;
[453]	540	end;
	541
[487]	542	procedure TfrmOptions.ApplyOtherStuff;
	543	// save other changes
	544	var
	545	aString: string;
[453]	546	begin
[487]	547	aString := '';
	548	if chkNotificationsFlagged.Checked then
	549	aString := aString + '^1'
	550	else
	551	aString := aString + '^0';
	552	rpcSetOtherStuff(aString);
	553	FdirtyOtherStuff := false;
[453]	554	end;
	555
[487]	556	procedure TfrmOptions.CheckApply;
	557	// determine if Apply button is enabled
	558	begin
	559	btnApply.Enabled := FdirtyOrderChecks or FdirtyNotifications or FdirtyOtherStuff;
	560	end;
[453]	561
[487]	562	procedure TfrmOptions.chkNotificationsFlaggedClick(Sender: TObject);
	563	// set notification flagged status
	564	begin
	565	FdirtyOtherStuff := true;
	566	CheckApply;
	567	end;
[453]	568
[487]	569	procedure TfrmOptions.LoadListView(aListView: TListView; aList: TStrings);
	570	// load a list view with: name, on/off, comment
	571	var
	572	i: integer;
	573	aListItem: TListItem;
	574	aRule: TRule;
	575	rulenum, ruletext, ruleonoff, rulecomment: string;
[453]	576	begin
[487]	577	FuseCheckBoxes := false;
	578	aListView.Items.Clear;
	579	aListView.SortType := stNone; // if Sorting during load then potential error
	580	with aList do
[453]	581	begin
[487]	582	for i := 0 to aList.Count - 1 do
[453]	583	begin
[487]	584	rulenum := Piece(aList[i], '^', 1);
	585	ruletext := Piece(aList[i], '^', 2);
	586	ruleonoff := Piece(aList[i], '^', 3);
	587	rulecomment := Piece(aList[i], '^', 4);
	588	aListItem := aListView.Items.Add;
	589	with aListItem do
	590	begin
	591	Caption := ruletext;
	592	SubItems.Add(ruleonoff);
	593	if ruleonoff = 'On' then Checked := true;
	594	SubItems.Add(rulecomment);
	595	end;
	596	aRule := TRule.Create;
	597	with aRule do
	598	begin
	599	IEN := rulenum;
	600	OriginalValue := ruleonoff;
	601	ItemText := ruletext;
	602	end;
	603	// aListItem.SubItems.AddObject('rule object', aRule); <-- original line. //kt 8/8/2007
	604	aListItem.SubItems.AddObject(DKLangConstW('fOptions_rule_object'), aRule); //kt added 8/8/2007
[453]	605	end;
	606	end;
[487]	607	aListView.SortType := stBoth;
	608	FuseCheckBoxes := true;
[453]	609	end;
	610
[487]	611	procedure TfrmOptions.lvwNotificationsChange(Sender: TObject;
	612	Item: TListItem; Change: TItemChange);
	613	// change on/off on checkmark
	614	begin
	615	if (Sender as TListView).ItemIndex = -1 then exit;
	616	if not FuseCheckBoxes then exit;
	617	if (Sender as TListView).Checkboxes = false then exit;
	618	//if (Item.SubItems[1] = 'Mandatory') and not Item.Checked then begin <-- original line. //kt 8/8/2007
	619	if (Item.SubItems[1] = DKLangConstW('fOptions_Mandatory')) and not Item.Checked then begin //kt added 8/8/2007
	620	Item.Checked := True;
	621	exit;
	622	end;
	623	if Item.Checked then
	624	begin
	625	if Item.SubItems[0] <> 'On' then
	626	ChangeOnOff(Sender as TListView, Item);
	627	Item.SubItems[0] := 'On';
	628	end
	629	else
	630	begin
	631	// if Item.SubItems[0] <> 'Off' then <-- original line. //kt 8/8/2007
	632	if Item.SubItems[0] <> DKLangConstW('fOptions_Off') then //kt added 8/8/2007
	633	ChangeOnOff(Sender as TListView, Item);
	634	// Item.SubItems[0] := 'Off'; <-- original line. //kt 8/8/2007
	635	Item.SubItems[0] := DKLangConstW('fOptions_Off'); //kt added 8/8/2007
	636	end;
[453]	637	end;
[487]	638
	639	procedure TfrmOptions.lvwNotificationsColumnClick(Sender: TObject;
	640	Column: TListColumn);
	641	// toggle sort
[453]	642	begin
[487]	643	if FsortCol = Column.Index then
	644	FsortAscending := not FsortAscending
	645	else
	646	FsortAscending := true;
	647	FsortCol := Column.Index;
	648	(Sender as TListView).AlphaSort;
	649	end;
	650
	651	procedure TfrmOptions.lvwNotificationsCompare(Sender: TObject; Item1,
	652	Item2: TListItem; Data: Integer; var Compare: Integer);
	653	// sort columns
[453]	654	begin
[487]	655	if not(Sender is TListView) then exit;
	656	if FsortAscending then
	657	begin
	658	if FsortCol = 0 then
	659	Compare := CompareStr(Item1.Caption, Item2.Caption)
	660	else
	661	Compare := CompareStr(Item1.SubItems[FsortCol - 1],
	662	Item2.SubItems[FsortCol - 1]);
	663	end
	664	else
	665	begin
	666	if FsortCol = 0 then
	667	Compare := CompareStr(Item2.Caption, Item1.Caption)
	668	else
	669	Compare := CompareStr(Item2.SubItems[FsortCol - 1],
	670	Item1.SubItems[FsortCol - 1]);
	671	end;
[453]	672	end;
	673
[487]	674	procedure TfrmOptions.lvwNotificationsDblClick(Sender: TObject);
	675	// toggle check marks with double click
	676	var
	677	aListItem: TListItem;
	678	begin
	679	with (Sender as TListView) do
	680	begin
	681	if Checkboxes = false then exit;
	682	if Selected = nil then exit;
	683	// if Selected.SubItems[1] = 'Mandatory' then exit; <-- original line. //kt 8/8/2007
	684	if Selected.SubItems[1] = DKLangConstW('fOptions_Mandatory') then exit; //kt added 8/8/2007
	685	if Selected <> FLastClickedItem then exit;
	686	aListItem := Selected;
	687	aListItem.Checked := not aListItem.Checked;
	688	ChangeOnOff(Sender as TListView, aListItem);
[453]	689
[487]	690	if aListItem.Checked then
	691	aListItem.SubItems[0] := 'On'
	692	else
	693	// aListItem.SubItems[0] := 'Off'; <-- original line. //kt 8/8/2007
	694	aListItem.SubItems[0] := DKLangConstW('fOptions_Off'); //kt added 8/8/2007
	695	end;
	696	end;
	697
	698	procedure TfrmOptions.ChangeOnOff(aListView: TListView; aListItem: TListItem);
	699	// check if list items were edited
[453]	700	begin
[487]	701	if aListView = lvwNotifications then FdirtyNotifications := true;
	702	if aListView = lvwOrderChecks then FdirtyOrderChecks := true;
	703	CheckApply;
	704	end;
	705
	706	procedure TfrmOptions.btnSurrogateClick(Sender: TObject);
	707	// display Surrogate Options
	708	var
	709	topsize, leftsize: integer;
	710	surrogateinfo: string;
[453]	711	begin
[487]	712	surrogateinfo := btnSurrogate.Hint;
	713	Offset(topsize, -30, leftsize, -30);
	714	DialogOptionsSurrogate(topsize, leftsize, Font.Size, surrogateinfo);
	715	LabelSurrogate(surrogateinfo, lblNotificationsSurrogateText);
	716	btnSurrogate.Hint := surrogateinfo;
[453]	717	end;
	718
[487]	719	procedure TfrmOptions.btnCombinationsClick(Sender: TObject);
	720	// display Combination List Options
	721	var
	722	topsize, leftsize, value: integer;
[453]	723	begin
[487]	724	value := 0;
	725	Offset(topsize, -60, leftsize, -60);
	726	DialogOptionsCombinations(topsize, leftsize, Font.Size, value);
	727	end;
[453]	728
[487]	729	procedure TfrmOptions.btnNotesNotesClick(Sender: TObject);
	730	// display Notes Options
	731	var
	732	topsize, leftsize, value: integer;
	733	begin
	734	value := 0;
	735	Offset(topsize, -60, leftsize, -60);
	736	DialogOptionsNotes(topsize, leftsize, Font.Size, value);
[453]	737	end;
	738
[487]	739	procedure TfrmOptions.btnNotesTitlesClick(Sender: TObject);
	740	// display Titles Options
	741	var
	742	topsize, leftsize, value: integer;
	743	begin
	744	value := 0;
	745	Offset(topsize, -60, leftsize, -60);
	746	DialogOptionsTitles(topsize, leftsize, Font.Size, value);
	747	end;
[453]	748
[487]	749	procedure TfrmOptions.btnReportsClick(Sender: TObject);
	750	var
	751	topsize, leftsize, value: integer;
	752	begin
	753	value := 0;
	754	Offset(topsize, 90, leftsize, 23);
	755	DialogOptionsHSDefault(topsize, leftsize, Font.Size, value);
	756	end;
[453]	757
[487]	758	procedure TfrmOptions.btnReport1Click(Sender: TObject);
	759	var
	760	topsize, leftsize, value: integer;
	761	begin
	762	value := 0;
	763	Offset(topsize, -18, leftsize, -15);
	764	DialogOptionsHSCustom(topsize, leftsize, Font.Size, value);
	765	end;
[453]	766
[487]	767	procedure TfrmOptions.lvwNotificationsEnter(Sender: TObject);
	768	begin
	769	with Sender as TListView do begin
	770	if (Selected = nil) and (Items.Count > 0) then
	771	Selected := Items[0];
	772	end;
	773	end;
[453]	774
[487]	775	procedure TfrmOptions.lvwNotificationsMouseDown(Sender: TObject;
	776	Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
	777	begin
	778	FLastClickedItem := (Sender as TListView).GetItemAt(X,Y);
	779	end;
[453]	780
[487]	781	procedure TfrmOptions.btnDiagnosesClick(Sender: TObject);
	782	// display Personal Diagnoses List
	783	var
	784	topsize, leftsize, value: integer;
	785	begin
	786	if IsCIDCProvider(User.DUZ) then //(hds7564)
	787	begin
	788	value := 0;
	789	Offset(topsize, -60, leftsize, -60);
	790	DialogOptionsDiagnoses(topsize, leftsize, Font.Size, value);
	791	end;
	792	end;
[453]	793
[487]	794	procedure TfrmOptions.btnGraphSettingsClick(Sender: TObject);
	795	// display GraphSettings
	796	var
	797	actiontype: boolean;
	798	topsize, leftsize: integer;
	799	begin
	800	actiontype := false;
	801	Offset(topsize, -60, leftsize, -60);
	802	DialogOptionsGraphSettings(topsize, leftsize, Font.Size, actiontype);
	803	end;
[453]	804
[487]	805	procedure TfrmOptions.btnGraphViewsClick(Sender: TObject);
	806	// display Graph Views
	807	var
	808	actiontype: boolean;
	809	topsize, leftsize: integer;
	810	begin
	811	actiontype := false;
	812	Offset(topsize, -60, leftsize, -60);
	813	DialogOptionsGraphProfiles(topsize, leftsize, Font.Size, actiontype);
[453]	814	end;
	815
[487]	816	procedure TfrmOptions.rdoRDVClick(Sender: TObject);
	817	var
	818	iIndex: integer;
	819	begin
	820	iIndex := rdoRDV.ItemIndex;
	821	with frmFrame do
	822	if iIndex = 0 then
	823	begin
	824	ChangeVistaWebParam('0');
	825	lblCIRN.Caption := ' Remote';
	826	lblCIRNData.Caption := 'Data';
	827	lblCIRNAvail.Caption := '';
	828	lblCIRN.Width := 43;
	829	lblCIRNData.Width := 43;
	830	lblCIRNData.Alignment := taCenter;
	831	lblCIRN.Alignment := taCenter;
	832	lstCIRNLocations.Clear;
	833	SetUpCIRN;
	834	end
	835	else
	836	begin
	837	ChangeVistaWebParam('1');
	838	lblCIRN.Caption := 'Remote';
	839	lblCIRNData.Caption := 'Data*'; //VistaWeb On
	840	lblCIRN.Width := 43;
	841	lblCIRNData.Width := 43;
	842	lblCIRNData.Alignment := taCenter;
	843	lblCIRN.Alignment := taCenter;
	844	lblCIRN.Enabled := True;
	845	lblCIRNData.Enabled := True;
	846	pnlCIRN.TabStop := True;
	847	if ColorToRGB(clWindowText) = ColorToRGB(clBlack) then
	848	begin
	849	lblCIRN.Font.Color := clBlue;
	850	lblCIRNData.Font.Color := clBlue;
	851	lblCIRNAvail.Font.Color := clBlue;
	852	lstCIRNLocations.Font.Color := clBlue;
	853	end
	854	else
	855	begin
	856	lblCIRN.Font.Color := clWindowText;
	857	lblCIRNData.Font.Color := clWindowText;
	858	lblCIRNAvail.Font.Color := clWindowText;
	859	lstCIRNLocations.Font.Color := clWindowText;
	860	end;
	861	end;
[453]	862
[487]	863	end;
	864
	865	procedure TfrmOptions.cbLanguageChange(Sender: TObject); //kt added 6/29/07
	866	var iIndex: Integer;
	867	CPRSChartINI: TINIFile;
[453]	868	begin
[487]	869	iIndex := cbLanguage.ItemIndex;
	870	if iIndex<0 then iIndex := 0; // When there's no valid selection in cbLanguage we use the default language (Index=0)
	871	try
	872	LangManager.LanguageID := LangManager.LanguageIDs[iIndex];
	873	except
	874	on EReadError do begin
	875	//do nothing. Ignore error.
	876	end
	877	end;
	878	frmFrame.Caption := TX_IN_USE + MixedCase(User.Name) + ' (' + RPCBrokerV.Server + ')'; //kt added
	879	frmFrame.RenameTabs; //Resets names of tabs to correct translation //kt
	880	frmFrame.mnuFileRefreshClick(self); //elh 6/23/08
	881	CPRSChartINI := TINIFile.Create(ExtractFilePath(ParamStr(0)) + 'CPRSChart.ini'); // Write to INI elh 6/23/08
	882	CPRSChartINI.WriteInteger('Options','Language',LangManager.LanguageID);
	883	CPRSChartINI.Free;
[453]	884	end;
	885
[487]	886	procedure TfrmOptions.Button1Click(Sender: TObject);
	887	begin
	888	MessageDlg('For a given language to be available, a *.lng (e.g. spanish.lng) '+
	889	'must be in the same directory as CPRSchart.exe. This *.lng file '+
	890	'may be created at any time by users by working with the CPRSchart.dklng '+
	891	'file with the free language editor found at: '+
	892	'http://www.dk-soft.org/products/dklang/',mtInformation,[mbOK],0);
	893	end;
[453]	894
[487]	895	procedure TfrmOptions.btnApplySkinClick(Sender: TObject); //kt added
	896	var fileS : String;
	897	begin
	898	{$IFDEF USE_SKINS}
	899	fileS := '';
	900	if lbSkins.ItemIndex > -1 then fileS := lbSkins.Items [lbSkins.ItemIndex];
	901	frmFrame.CurrentSkinFile := 'TMG_Extra\Skins\' +fileS;
	902	frmFrame.ActivateCurrentSkin;
[489]	903	btnApplyClick(btnOK);
[487]	904	{$ELSE}
	905	MessageDlg('Use of skins has been disabled at compile time.',mtInformation,[mbOK],0);
	906	{$ENDIF}
	907	end;
[453]	908
[487]	909	procedure TfrmOptions.btnMoreSkinsClick(Sender: TObject); //kt added
	910	begin
	911	ShellExecute (Handle, 'open', 'http://www2.wincustomize.com/Skins.aspx?LibID=12&view=1&sortby=9&sortdir=DESC&p=1&advanced=0&mode=1&u=0', nil, nil, SW_SHOWNORMAL);
	912	end;
	913
	914	procedure TfrmOptions.FillSkinList; //kt added
	915	var
	916	SRec : TSearchRec;
	917	R : Integer;
	918	begin
	919	lbSkins.Items.Clear;
	920	R := FindFirst (ExtractFilePath (Application.ExeName) + 'TMG_Extra\Skins\*.ipz', faAnyFile, SRec);
	921	while R = 0 do
[453]	922	begin
[487]	923	lbSkins.Items.Add (SRec.Name);
	924	R := FindNext (SRec);
[453]	925	end;
[487]	926	lbSkins.Sorted := true;
	927	lbSkins.ItemIndex := 0;
	928	end;
[453]	929
[487]	930	procedure TfrmOptions.FormShow(Sender: TObject); //kt added
	931	begin
	932	FillSkinList;
	933	end;
[453]	934
[487]	935	procedure TfrmOptions.lbSkinsKeyPress(Sender: TObject; var Key: Char); //kt added
	936	begin
	937	if Key = #13 then btnApplySkinClick (Self);
[453]	938	end;
	939
[487]	940	procedure TfrmOptions.btnDisableSkinClick(Sender: TObject); //kt added
	941	begin
	942	frmFrame.InactivateSkin;
	943	end;
[453]	944
	945	end.
	946

Note: See TracBrowser for help on using the repository browser.

Download in other formats: