//kt -- Modified with SourceScanner on 8/8/2007 unit fOptionsOther; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, ComCtrls, ORCtrls, ORFn, rOrders, uCore, ORDtTm, DKLang; type TfrmOptionsOther = class(TForm) pnlBottom: TPanel; btnOK: TButton; btnCancel: TButton; bvlBottom: TBevel; stStart: TStaticText; stStop: TStaticText; dtStart: TORDateBox; dtStop: TORDateBox; lblMedsTab: TLabel; lblTabDefault: TStaticText; lblTab: TLabel; cboTab: TORComboBox; chkLastTab: TCheckBox; Bevel1: TBevel; lblEncAppts: TLabel; stStartEncAppts: TStaticText; txtTodayMinus: TStaticText; txtEncStart: TCaptionEdit; txtDaysMinus: TStaticText; spnEncStart: TUpDown; txtDaysPlus: TStaticText; spnEncStop: TUpDown; txtEncStop: TCaptionEdit; txtTodayPlus: TStaticText; stStopEncAppts: TStaticText; Bevel2: TBevel; btnEncDefaults: TButton; DKLanguageController1: TDKLanguageController; TabPositionComboBox: TComboBox; Label1: TLabel; lblTabColors: TLabel; pnlShowColor: TPanel; ColorDialog: TColorDialog; lblEditTabColor: TLabel; cboTabColors: TComboBox; cbEnableTabColors: TCheckBox; procedure FormShow(Sender: TObject); procedure btnOKClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure dtStartExit(Sender: TObject); procedure dtStopExit(Sender: TObject); procedure dtStartChange(Sender: TObject); procedure txtEncStartChange(Sender: TObject); procedure txtEncStopChange(Sender: TObject); procedure txtEncStartExit(Sender: TObject); procedure txtEncStopExit(Sender: TObject); procedure btnEncDefaultsClick(Sender: TObject); procedure TabPositionComboBoxChange(Sender: TObject); procedure cboTabColorsChange(Sender: TObject); procedure pnlShowColorClick(Sender: TObject); procedure cbEnableTabColorsClick(Sender: TObject); private { Private declarations } FstartDt: TFMDateTime; FstopDt: TFMDateTime; FEncStartDays, FEncStopDays, FEncDefStartDays, FEncDefStopDays: integer; //FDefaultEvent: string; public { Public declarations } procedure SaveTabColors(ColorsList : TStringList); //kt end; var frmOptionsOther: TfrmOptionsOther; const ENC_MAX_LIMIT = 999; procedure DialogOptionsOther(topvalue, leftvalue, fontsize: integer; var actiontype: Integer); procedure SetTabPosition(Position : TTabPosition); //kt implementation {$R *.DFM} uses rOptions, uOptions, rCore, rSurgery, uConst, fMeds, fFrame, uTMGOptions //kt ; procedure DialogOptionsOther(topvalue, leftvalue, fontsize: integer; var actiontype: Integer); // create the form and make it modal, return an action var frmOptionsOther: TfrmOptionsOther; begin frmOptionsOther := TfrmOptionsOther.Create(Application); actiontype := 0; try with frmOptionsOther do begin if (topvalue < 0) or (leftvalue < 0) then Position := poScreenCenter else begin Position := poDesigned; Top := topvalue; Left := leftvalue; end; ResizeAnchoredFormToFont(frmOptionsOther); ShowModal; actiontype := btnOK.Tag; end; finally frmOptionsOther.Release; end; end; procedure TfrmOptionsOther.FormShow(Sender: TObject); // displays defaults // opening tab^use last tab^autosave seconds^verify note title var last: integer; values, tab: string; begin cboTabColors.Items.Assign(frmFrame.tabPage.Tabs); //kt 8/09 //cboTabColors.Items.Assign(TabColorsList); //kt added8808 cboTabColors.ItemIndex := 0; //kt cboTab.Items.Assign(rpcGetOtherTabs); //kt cboTabColorsChange(nil); //kt cbEnableTabColors.Checked := TabColorsEnabled; //kt 8/09 //if (cboTab.Items.IndexOf('Surgery') > -1) and (not ShowSurgeryTab) then <-- original line. //kt 8/8/2007 if (cboTab.Items.IndexOf(DKLangConstW('fOptionsOther_Surgery')) > -1) and (not ShowSurgeryTab) then //kt added 8/8/2007 // cboTab.Items.Delete(cboTab.Items.IndexOf('Surgery')); <-- original line. //kt 8/8/2007 cboTab.Items.Delete(cboTab.Items.IndexOf(DKLangConstW('fOptionsOther_Surgery'))); //kt added 8/8/2007 values := rpcGetOther; tab := Piece(values, '^', 1); last := strtointdef(Piece(values, '^', 2), 0); cboTab.SelectByID(tab); cboTab.Tag := strtointdef(tab, -1); chkLastTab.Checked := last = 1; chkLastTab.Tag := last; cboTab.SetFocus; rpcGetRangeForMeds(FstartDt, FstopDt); if FstartDt > 1 then dtStart.Text := FormatFMDateTime('mmm d, yyyy',FstartDt); if FstopDt > 1 then dtStop.Text := FormatFMDateTime('mmm d, yyyy', FstopDt); rpcGetRangeForEncs(FEncDefStartDays, FEncDefStopDays, True); // True gets params settings above User/Service level. if FEncDefStartDays < 1 then FEncDefStartDays := 0; if FEncDefStopDays < 1 then FEncDefStopDays := 0; rpcGetRangeForEncs(FEncStartDays, FEncStopDays, False); // False gets User/Service params. if ((FEncStartDays < 0) and (FEncStartDays <> 0)) then FEncStartDays := FEncDefStartDays; txtEncStart.Text := IntToStr(FEncStartDays); if ((FEncStopDays < 0) and (FEncStopDays <> 0)) then FEncStopDays := FEncDefStopDays; txtEncStop.Text := IntToStr(FEncStopDays); end; procedure TfrmOptionsOther.btnOKClick(Sender: TObject); // opening tab^use last tab^autosave seconds^verify note title var values, theVal: string; begin values := ''; if cboTab.ItemIEN <> cboTab.Tag then values := values + cboTab.ItemID; values := values + '^'; if chkLastTab.Checked then if chkLastTab.Tag <> 1 then values := values + '1'; if not chkLastTab.Checked then if chkLastTab.Tag <> 0 then values := values + '0'; values := values + '^^'; rpcSetOther(values); if (dtStop.FMDateTime > 0) and (dtStart.FMDateTime > 0) then begin if dtStop.FMDateTime < dtStart.FMDateTime then begin // ShowMessage('The stop time can not prior to the start time.'); <-- original line. //kt 8/8/2007 ShowMessage(DKLangConstW('fOptionsOther_The_stop_time_can_not_prior_to_the_start_timex')); //kt added 8/8/2007 dtStop.FMDateTime := FMToday; dtStop.SetFocus; Exit; end; theVal := dtStart.RelativeTime + ';' + dtStop.RelativeTime; rpcPutRangeForMeds(theVal); end; if (dtStart.Text = '') and (dtStop.Text = '') then rpcPutRangeForMeds(''); rpcPutRangeForEncs(txtEncStart.Text, txtEncStop.Text); if frmMeds <> nil then frmMeds.RefreshMedLists; end; procedure TfrmOptionsOther.FormCreate(Sender: TObject); begin cbEnableTabColors.checked := TabColorsEnabled; FStartDT := 0; FStopDT := 0; end; procedure TfrmOptionsOther.dtStartExit(Sender: TObject); begin if dtStart.FMDateTime > FMToday then begin // ShowMessage('Start time can not greater than today.'); <-- original line. //kt 8/8/2007 ShowMessage(DKLangConstW('fOptionsOther_Start_time_can_not_greater_than_todayx')); //kt added 8/8/2007 dtStart.FMDateTime := FMToday; dtStart.SetFocus; Exit; end; end; procedure TfrmOptionsOther.dtStopExit(Sender: TObject); begin if (dtStop.FMDateTime > 0) and (dtStart.FMDateTime > 0) then if (dtStop.FMDateTime < dtStart.FMDateTime) then begin // ShowMessage('Stop time can not prior to start time'); <-- original line. //kt 8/8/2007 ShowMessage(DKLangConstW('fOptionsOther_Stop_time_can_not_prior_to_start_time')); //kt added 8/8/2007 dtStop.FMDateTime := FMToday; dtStop.SetFocus; Exit; end; end; procedure TfrmOptionsOther.dtStartChange(Sender: TObject); begin if (dtStart.FMDateTime > FMToday) then begin // ShowMessage('Start time can not greater than today.'); <-- original line. //kt 8/8/2007 ShowMessage(DKLangConstW('fOptionsOther_Start_time_can_not_greater_than_todayx')); //kt added 8/8/2007 dtStart.FMDateTime := FMToday; dtStart.SetFocus; Exit; end; end; procedure TfrmOptionsOther.txtEncStartChange(Sender: TObject); begin with txtEncStart do begin if Text = '' then Exit; if Text = ' ' then Text := '0'; if StrToInt(Text) < 0 then Text := '0'; if StrToIntDef(Text, ENC_MAX_LIMIT) > ENC_MAX_LIMIT then begin Text := IntToStr(ENC_MAX_LIMIT); Beep; // InfoBox('Number must be < ' + IntToStr(ENC_MAX_LIMIT), 'Warning', MB_OK or MB_ICONWARNING); <-- original line. //kt 8/8/2007 InfoBox(DKLangConstW('fOptionsOther_Number_must_be_x')+' ' + IntToStr(ENC_MAX_LIMIT), DKLangConstW('fOptionsOther_Warning'), MB_OK or MB_ICONWARNING); //kt added 8/8/2007 end; end; end; procedure TfrmOptionsOther.txtEncStopChange(Sender: TObject); begin with txtEncStop do begin if Text = '' then Exit; if Text = ' ' then Text := '0'; if StrToInt(Text) < 0 then Text := '0'; if StrToIntDef(Text, ENC_MAX_LIMIT) > ENC_MAX_LIMIT then begin Text := IntToStr(ENC_MAX_LIMIT); Beep; // InfoBox('Number must be < ' + IntToStr(ENC_MAX_LIMIT), 'Warning', MB_OK or MB_ICONWARNING); <-- original line. //kt 8/8/2007 InfoBox(DKLangConstW('fOptionsOther_Number_must_be_x') + IntToStr(ENC_MAX_LIMIT), DKLangConstW('fOptionsOther_Warning'), MB_OK or MB_ICONWARNING); //kt added 8/8/2007 end; end; end; procedure TfrmOptionsOther.txtEncStartExit(Sender: TObject); begin with txtEncStart do if Text = '' then Text := '0'; end; procedure TfrmOptionsOther.txtEncStopExit(Sender: TObject); begin with txtEncStart do if Text = '' then Text := '0'; end; procedure TfrmOptionsOther.btnEncDefaultsClick(Sender: TObject); begin txtEncStart.Text := IntToStr(FEncDefStartDays); txtEncStop.Text := IntToStr(FEncDefStopDays); end; procedure TfrmOptionsOther.TabPositionComboBoxChange(Sender: TObject); //kt added 8/8/08 begin Case TabPositionComboBox.ItemIndex of 0 : SetTabPosition(tpBottom); 1 : SetTabPosition(tpTop); 2 : SetTabPosition(tpLeft); 3 : SetTabPosition(tpRight); end; {case} end; procedure SetTabPosition(Position : TTabPosition); //NOTE: Don't make this a member function of TFrmOptionsOther, becuase frmFrame needs // to be able to call it, even if the OtionsOther form is not instantiated. //kt added 8/8/08 begin frmFrame.tabPage.TabPosition := Position; Case Position of tpBottom : frmFrame.tabPage.Align := alBottom; tpTop: frmFrame.tabPage.Align := alTop; tpLeft: frmFrame.tabPage.Align := alLeft; tpRight : frmFrame.tabPage.Align := alRight; end; {case} uTMGOptions.WriteInteger('Tab Location',integer(frmFrame.tabPage.TabPosition)); end; procedure TfrmOptionsOther.SaveTabColors(ColorsList : TStringList); //kt added 8/8/08 Entire function var i : integer; begin for i := 0 to ColorsList.Count-1 do begin uTMGOptions.WriteInteger('Tab '+IntToStr(i)+' Color',longword(ColorsList.Objects[i])); end; uTMGOptions.WriteBool('TAB_COLORS ENABLE',TabColorsEnabled); //kt 8/09 end; procedure TfrmOptionsOther.cboTabColorsChange(Sender: TObject); var color : TColor; selIndex : integer; begin selIndex := cboTabColors.ItemIndex; if selIndex < 0 then exit; color := TColor(cboTabColors.Items.Objects[selIndex]); pnlShowColor.Color := color; end; procedure TfrmOptionsOther.pnlShowColorClick(Sender: TObject); //kt added 8/8/08 var s : string; selIndex : integer; begin if ColorDialog.Execute then begin pnlShowColor.Color := ColorDialog.Color; selIndex := cboTabColors.ItemIndex; if selIndex < 0 then exit; cboTabColors.Items.Objects[selIndex] := pointer(ColorDialog.Color); TabColorsList.Objects[selIndex] := pointer(ColorDialog.Color); uTMGOptions.WriteInteger('Tab '+IntToStr(selIndex)+' Color',longword(TabColorsList.Objects[selIndex])); end; end; procedure TfrmOptionsOther.cbEnableTabColorsClick(Sender: TObject); //kt added begin TabColorsEnabled := cbEnableTabColors.Checked; //elh 01/12/10 frmFrame.tabPage.OwnerDraw := cbEnableTabColors.Checked; //elh 01/12/10 cboTabColors.Enabled := TabColorsEnabled; lblEditTabColor.Enabled := TabColorsEnabled; lblTabColors.Enabled := TabColorsEnabled; pnlShowColor.Enabled := TabColorsEnabled; uTMGOptions.WriteBool('TAB_COLORS ENABLE',TabColorsEnabled); //kt 3/8/10 end; end.