unit fRemCoverSheet; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ORCtrls, StdCtrls, ExtCtrls, ComCtrls, ImgList, mImgText, Buttons, ORClasses; type TRemCoverDataLevel = (dlPackage, dlSystem, dlDivision, dlService, dlLocation, dlUserClass, dlUser); TfrmRemCoverSheet = class(TForm) pnlBottom: TORAutoPanel; pnlUser: TPanel; cbxUserLoc: TORComboBox; lblRemLoc: TLabel; pnlMiddle: TPanel; lvView: TCaptionListView; pnlRight: TPanel; mlgnCat: TfraImgText; mlgnRem: TfraImgText; mlgnAdd: TfraImgText; pnlCAC: TORAutoPanel; mlgnRemove: TfraImgText; mlgnLock: TfraImgText; imgMain: TImageList; sbUp: TBitBtn; sbDown: TBitBtn; btnAdd: TBitBtn; btnRemove: TBitBtn; btnLock: TBitBtn; pnlBtns: TPanel; btnOK: TButton; btnCancel: TButton; edtSeq: TCaptionEdit; udSeq: TUpDown; lblSeq: TLabel; btnApply: TButton; cbSystem: TORCheckBox; cbDivision: TORCheckBox; cbService: TORCheckBox; cbxService: TORComboBox; cbxDivision: TORComboBox; cbLocation: TORCheckBox; cbUserClass: TORCheckBox; cbUser: TORCheckBox; cbxUser: TORComboBox; cbxClass: TORComboBox; cbxLocation: TORComboBox; lblEdit: TLabel; pnlInfo: TPanel; pnlTree: TPanel; tvAll: TORTreeView; lblTree: TLabel; pnlCover: TPanel; lvCover: TCaptionListView; pblMoveBtns: TPanel; sbCopyRight: TBitBtn; sbCopyLeft: TBitBtn; splMain: TSplitter; lblView: TLabel; lblCAC: TStaticText; btnView: TButton; lblLegend: TLabel; procedure cbxLocationNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer); procedure cbxServiceNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer); procedure cbxUserNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer); procedure cbxClassNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer); procedure FormDestroy(Sender: TObject); procedure cbxDivisionChange(Sender: TObject); procedure cbxServiceChange(Sender: TObject); procedure cbxLocationChange(Sender: TObject); procedure cbxClassChange(Sender: TObject); procedure cbxUserChange(Sender: TObject); procedure cbxDropDownClose(Sender: TObject); procedure cbEditLevelClick(Sender: TObject); procedure tvAllExpanding(Sender: TObject; Node: TTreeNode; var AllowExpansion: Boolean); procedure edtSeqChange(Sender: TObject); procedure tvAllExpanded(Sender: TObject; Node: TTreeNode); procedure tvAllChange(Sender: TObject; Node: TTreeNode); procedure lvCoverChange(Sender: TObject; Item: TListItem; Change: TItemChange); procedure btnAddClick(Sender: TObject); procedure btnRemoveClick(Sender: TObject); procedure btnLockClick(Sender: TObject); procedure lvViewColumnClick(Sender: TObject; Column: TListColumn); procedure lvCoverColumnClick(Sender: TObject; Column: TListColumn); procedure lvViewCompare(Sender: TObject; Item1, Item2: TListItem; Data: Integer; var Compare: Integer); procedure lvCoverCompare(Sender: TObject; Item1, Item2: TListItem; Data: Integer; var Compare: Integer); procedure sbUpClick(Sender: TObject); procedure sbDownClick(Sender: TObject); procedure sbCopyRightClick(Sender: TObject); procedure udSeqChangingEx(Sender: TObject; var AllowChange: Boolean; NewValue: Smallint; Direction: TUpDownDirection); procedure sbCopyLeftClick(Sender: TObject); procedure tvAllDblClick(Sender: TObject); procedure btnApplyClick(Sender: TObject); procedure btnOKClick(Sender: TObject); procedure lvCoverDblClick(Sender: TObject); procedure lvViewClick(Sender: TObject); procedure btnViewClick(Sender: TObject); procedure lvCoverKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure edtSeqKeyPress(Sender: TObject; var Key: Char); procedure cbxDivisionKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); private FData: TORStringList; // DataCode IEN ^ Modified Flag Object=TStringList FUserInfo: TORStringList; // C^User Class, D^Division FUser: Int64; FUserMode: boolean; FInitialized: boolean; FCurDiv: Integer; FCurSer:Integer; FCurLoc: Integer; FCurClass: Integer; FCurUser: Int64; FDivisions: TORStringList; FServices: TORStringList; FLocations: TORStringList; FClasses: TORStringList; FUsers: TORStringList; FMasterList: TORStringList; FUpdatePending: TORCheckBox; FCatInfo: TORStringList; FEditingLevel: TRemCoverDataLevel; FEditingIEN: Int64; FUpdating: boolean; FTopSortTag: integer; FTopSortUp: boolean; FBottomSortTag: integer; FBottomSortUp: boolean; FDataSaved: boolean; FUpdatingView: boolean; FInternalExpansion: boolean; procedure GetUserInfo(AUser: Int64); function GetCurrent(IEN: Int64; Level: TRemCoverDataLevel; Show: boolean; Add: boolean = FALSE): TORStringList; procedure UpdateView; procedure SetupItem(Item: TListItem; const Data: string); overload; procedure SetupItem(Item: TListItem; const Data: string; Level: TRemCoverDataLevel; IEN: Int64); overload; function GetExternalName(Level: TRemCoverDataLevel; IEN: Int64): string; procedure UpdateMasterListView; procedure UpdateButtons; function GetCatInfo(CatIEN: string): TORStringList; procedure MarkListAsChanged; function GetIndex(List: TORStringList; Item: TListItem): integer; procedure ChangeStatus(Code: string); procedure SetSeq(Item: TListItem; const Value: string); function ListHasData(Seq: string; SubIdx: integer): boolean; procedure SaveData(FromApply: boolean); function RPad(Str: String): String; function GetCoverSheetLvlData(ALevel, AClass: string): TStrings; public procedure Init(AsUser: boolean); end; procedure EditCoverSheetReminderList(AsUser: boolean); implementation uses rCore, uCore, uPCE, rProbs, rTIU, ORFn, rReminders, uReminders, fRemCoverPreview; {$R *.DFM} const DataCode: array[TRemCoverDataLevel] of string[1] = { dlPackage } ('P', { dlSystem } 'S', { dlDivision } 'D', { dlService } 'R', { dlLocation } 'L', { dlUserClass } 'C', { dlUser } 'U'); DataName: array[TRemCoverDataLevel] of string = { dlPackage } ('Package', { dlSystem } 'System', { dlDivision } 'Division', { dlService } 'Service', { dlLocation } 'Location', { dlUserClass } 'User Class', { dlUser } 'User'); InternalName: array[TRemCoverDataLevel] of string = { dlPackage } ('PKG', { dlSystem } 'SYS', { dlDivision } 'DIV', { dlService } 'SRV', { dlLocation } 'LOC', { dlUserClass } 'CLASS', { dlUser } 'USR'); UserClassCode = 'C'; DivisionCode = 'D'; ServiceCode = 'S'; CVLockCode = 'L'; CVAddCode = 'N'; CVRemoveCode = 'R'; CVCatCode = 'C'; CVRemCode = 'R'; DummyNode = '^@Dummy Node@^'; IdxSeq = 0; IdxLvl = 1; IdxType = 2; IdxTIEN = 3; IdxLvl2 = 4; IdxAdd = 5; IdxIEN = 6; procedure EditCoverSheetReminderList(AsUser: boolean); var frmRemCoverSheet: TfrmRemCoverSheet; begin frmRemCoverSheet := TfrmRemCoverSheet.Create(Application); try frmRemCoverSheet.Init(AsUser); frmRemCoverSheet.ShowModal; if frmRemCoverSheet.FDataSaved then ResetReminderLoad; finally frmRemCoverSheet.Free; end; end; { TfrmRemCoverSheet } procedure TfrmRemCoverSheet.Init(AsUser: boolean); const RemClsCode = ' NVL'; RemClsText:array[1..4] of string = ('','National','VISN','Local'); var LocCombo: TORComboBox; i, idx: integer; tmp, tmp2, tmp3: string; Node: TORTreeNode; begin FTopSortTag := 3; FTopSortUp := TRUE; FBottomSortTag := 2; FBottomSortUp := TRUE; FEditingLevel := dlPackage; ResizeAnchoredFormToFont(self); pnlBtns.Top := pnlBottom.Top + pnlBottom.Height; FCatInfo := TORStringList.Create; FData := TORStringList.Create; FUserInfo := TORStringList.Create; FDivisions := TORStringList.Create; FServices := TORStringList.Create; FLocations := TORStringList.Create; FClasses := TORStringList.Create; FUsers := TORStringList.Create; FMasterList := TORStringList.Create; FMasterList.Assign(GetAllRemindersAndCategories); for i := 0 to FMasterList.Count-1 do begin tmp := FMasterList[i]; tmp2 := piece(tmp,U,4); if tmp2 = piece(tmp,U,3) then tmp2 := ''; tmp3 := piece(tmp,U,5); if tmp3 = '' then tmp3 := ' '; idx := pos(tmp3,RemClsCode); if idx > 0 then tmp3 := RemClsText[idx] else tmp3 := ''; if tmp3 <> '' then begin if tmp2 <> '' then tmp2 := tmp2 + ' - '; tmp2 := tmp2 + tmp3; end; if tmp2 <> '' then tmp2 := ' (' + tmp2 + ')'; tmp := Piece(tmp,U,1) + Pieces(tmp,U,2,3) + tmp2 + U + tmp2; FMasterList[i] := tmp; end; FUserMode := AsUser; FCurUser := User.DUZ; GetUserInfo(User.DUZ); FCurLoc := Encounter.Location; idx := FUserInfo.IndexOfPiece(DivisionCode); if idx >= 0 then FCurDiv := StrToIntDef(Piece(FUserInfo[idx],U,2),0) else FCurDiv := 0; idx := FUserInfo.IndexOfPiece(ServiceCode); if idx >= 0 then FCurSer := StrToIntDef(Piece(FUserInfo[idx],U,2),0) else FCurSer := User.Service; cbxUser.InitLongList(User.Name); cbxUser.SelectByIEN(FCurUser); GetPCECodes(FDivisions, TAG_HISTLOC); FDivisions.Delete(0); FCurClass := 0; if AsUser then begin pnlCAC.Visible := FALSE; LocCombo := cbxUserLoc; btnLock.Visible := FALSE; end else begin pnlUser.Visible := FALSE; LocCombo := cbxLocation; cbxDivision.Items.Assign(FDivisions); cbxDivision.SelectByIEN(FCurDiv); cbxService.InitLongList(GetExternalName(dlService, FCurSer)); cbxService.SelectByIEN(FCurSer); cbxClass.InitLongList(''); if FCurClass <> 0 then cbxClass.SelectByIEN(FCurClass); end; LocCombo.InitLongList(Encounter.LocationName); LocCombo.SelectByIEN(FCurLoc); if AsUser then cbUser.Checked := TRUE; tvAll.Items.BeginUpdate; try for i := 0 to FMasterList.Count-1 do begin Node := TORTreeNode(tvAll.Items.Add(nil,'')); Node.StringData := FMasterList[i]; if copy(FMasterList[i],1,1) = CVCatCode then begin idx := 1; tvAll.Items.AddChild(Node, DummyNode); end else idx := 0; Node.ImageIndex := idx; Node.SelectedIndex := idx; end; finally tvAll.Items.EndUpdate; end; FInitialized := TRUE; UpdateView; UpdateButtons; end; procedure TfrmRemCoverSheet.cbxLocationNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer); begin TORComboBox(Sender).ForDataUse(SubSetOfLocations(StartFrom, Direction)); end; procedure TfrmRemCoverSheet.cbxServiceNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer); begin cbxService.ForDataUse(ServiceSearch(StartFrom, Direction, TRUE)); end; procedure TfrmRemCoverSheet.cbxUserNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer); begin cbxUser.ForDataUse(SubSetOfPersons(StartFrom, Direction)); end; procedure TfrmRemCoverSheet.cbxClassNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer); begin cbxClass.ForDataUse(SubSetOfUserClasses(StartFrom, Direction)); end; procedure TfrmRemCoverSheet.FormDestroy(Sender: TObject); begin FMasterList.Free; FUsers.Free; FClasses.Free; FLocations.Free; FServices.Free; FDivisions.Free; FUserInfo.Free; FData.KillObjects; FData.Free; FCatInfo.KillObjects; FCatInfo.Free; end; procedure TfrmRemCoverSheet.GetUserInfo(AUser: Int64); begin if FUser <> AUser then begin FUser := AUser; FUserInfo.Assign(UserDivClassInfo(FUser)); end; end; function TfrmRemCoverSheet.GetCurrent(IEN: Int64; Level: TRemCoverDataLevel; Show: boolean; Add: boolean = FALSE): TORStringList; var lvl, cls, sIEN: string; tmpSL: TORStringList; i, idx: integer; begin idx := FData.IndexOfPiece(DataCode[Level] + IntToStr(IEN)); if idx < 0 then begin if (IEN = 0) and (not (Level in [dlPackage, dlSystem])) then begin Result := nil; exit; end; cls := ''; sIEN := IntToStr(IEN); lvl := InternalName[Level]; case Level of dlDivision, dlService, dlLocation, dlUser: lvl := lvl + '.`' + sIEN; dlUserClass: cls := sIEN; end; if (lvl <> '') then begin tmpSL := TORStringList.Create; try tmpSL.Assign(GetCoverSheetLvlData(lvl, cls)); if (not Add) and (tmpSL.Count = 0) then FreeAndNil(tmpSL); idx := FData.AddObject(DataCode[Level] + IntToStr(IEN), tmpSL); except tmpSL.Free; raise; end; end; end; if idx >= 0 then begin tmpSL := TORStringList(FData.Objects[idx]); if Add and (not assigned(tmpSL)) then begin tmpSL := TORStringList.Create; FData.Objects[idx] := tmpSL; end; end else tmpSL := nil; if Show and assigned(tmpSL) then begin for i := 0 to tmpSL.Count-1 do SetupItem(lvView.Items.Add, tmpSL[i], Level, IEN); end; Result := tmpSL; end; procedure TfrmRemCoverSheet.UpdateView; var idx: integer; begin if FInitialized and (not FUpdatingView) then begin lvView.Items.BeginUpdate; try lvView.Items.Clear; GetCurrent(0, dlPackage, TRUE); GetCurrent(0, dlSystem, TRUE); GetCurrent(FCurDiv, dlDivision, TRUE); GetCurrent(FCurSer, dlService, TRUE); GetCurrent(FCurLoc, dlLocation, TRUE); if FCurClass > 0 then GetCurrent(FCurClass, dlUserClass, TRUE) else begin idx := -1; repeat idx := FUserInfo.IndexOfPiece(UserClassCode,U,1,idx); if idx >= 0 then GetCurrent(StrToIntDef(Piece(FUserInfo[idx],U,2),0), dlUserClass, TRUE) until(idx < 0); end; GetCurrent(FCurUser, dlUser, TRUE); finally lvView.Items.EndUpdate; end; end; end; procedure TfrmRemCoverSheet.SetupItem(Item: TListItem; const Data: string); var AddCode, RemCode, rIEN, Seq: string; begin Seq := Piece(Data,U,1); rIEN := Piece(Data,U,2); Item.Caption := Piece(Data,U,3); AddCode := copy(rIEN,1,1); RemCode := copy(rIEN,2,1); delete(rIEN,1,1); if AddCode = CVLockCode then Item.StateIndex := 5 else if AddCode = CVRemoveCode then Item.StateIndex := 4 else if AddCode = CVAddCode then Item.StateIndex := 3; if RemCode = CVCatCode then Item.ImageIndex := 1 else if RemCode = CVRemCode then Item.ImageIndex := 0 else Item.ImageIndex := -1; Item.SubItems.Clear; Item.SubItems.Add(Seq); // IdxSeq = 0 Item.SubItems.Add(''); // IdxLvl = 1 Item.SubItems.Add(''); // IdxType = 2 Item.SubItems.Add(''); // IdxTIEN = 3 Item.SubItems.Add(''); // IdxLvl2 = 4 Item.SubItems.Add(AddCode); // IdxAdd = 5 Item.SubItems.Add(rIEN); // IdxIEN = 6 end; procedure TfrmRemCoverSheet.SetupItem(Item: TListItem; const Data: string; Level: TRemCoverDataLevel; IEN: Int64); begin SetupItem(Item, Data); Item.SubItems[IdxLvl] := DataName[Level]; Item.SubItems[IdxType] := GetExternalName(Level, IEN); Item.SubItems[IdxTIEN] := IntToStr(IEN); Item.SubItems[IdxLvl2] := IntToStr(ord(Level)); end; function TfrmRemCoverSheet.GetExternalName(Level: TRemCoverDataLevel; IEN: Int64): string; function GetNameFromList(List: TORStringList; IEN: Int64; FileNum: Double): string; var idx: integer; begin idx := List.IndexOfPiece(IntToStr(IEN)); if idx < 0 then idx := List.Add(IntToStr(IEN) + U + ExternalName(IEN, FileNum)); Result := piece(List[idx],U,2); end; begin case Level of dlDivision: Result := GetNameFromList(FDivisions, IEN, 4); dlService: Result := GetNameFromList(FServices, IEN, 49); dlLocation: Result := GetNameFromList(FLocations, IEN, 44); dlUserClass: Result := GetNameFromList(FClasses, IEN, 8930); dlUser: Result := GetNameFromList(FUsers, IEN, 200); else Result := ''; end; end; procedure TfrmRemCoverSheet.cbxDivisionChange(Sender: TObject); begin FCurDiv := cbxDivision.ItemIEN; FUpdatePending := cbDivision; if not cbxDivision.DroppedDown then cbxDropDownClose(nil); end; procedure TfrmRemCoverSheet.cbxServiceChange(Sender: TObject); begin FCurSer := cbxService.ItemIEN; FUpdatePending := cbService; if not cbxService.DroppedDown then cbxDropDownClose(nil); end; procedure TfrmRemCoverSheet.cbxLocationChange(Sender: TObject); begin FCurLoc := TORComboBox(Sender).ItemIEN; FUpdatePending := cbLocation; if not TORComboBox(Sender).DroppedDown then cbxDropDownClose(nil); end; procedure TfrmRemCoverSheet.cbxClassChange(Sender: TObject); begin FCurClass := cbxClass.ItemIEN; FUpdatePending := cbUserClass; if not cbxClass.DroppedDown then cbxDropDownClose(nil); end; procedure TfrmRemCoverSheet.cbxUserChange(Sender: TObject); var NewVal, idx: integer; begin FCurUser := cbxUser.ItemIEN; GetUserInfo(FCurUser); idx := FUserInfo.IndexOfPiece(DivisionCode); if idx >= 0 then begin NewVal := StrToIntDef(Piece(FUserInfo[idx],U,2),0); if NewVal <> FCurDiv then begin FCurDiv := NewVal; cbxDivision.InitLongList(GetExternalName(dlDivision, NewVal)); cbxDivision.SelectByIEN(NewVal); end; end; idx := FUserInfo.IndexOfPiece(ServiceCode); if idx >= 0 then begin NewVal := StrToIntDef(Piece(FUserInfo[idx],U,2),0); if NewVal <> FCurSer then begin FCurSer := NewVal; cbxService.InitLongList(GetExternalName(dlService, NewVal)); cbxService.SelectByIEN(NewVal); end; end; FCurClass := 0; cbxClass.ItemIndex := -1; FUpdatePending := cbUser; if not cbxUser.DroppedDown then cbxDropDownClose(nil); end; procedure TfrmRemCoverSheet.cbxDropDownClose(Sender: TObject); begin if assigned(FUpdatePending) then begin UpdateView; if FInitialized and (not FUserMode) then begin if FUpdatePending.Checked then cbEditLevelClick(FUpdatePending) else FUpdatePending.Checked := TRUE; end; FUpdatePending := nil; end; end; procedure TfrmRemCoverSheet.cbEditLevelClick(Sender: TObject); var cb: TORCheckBox; tmp: string; begin cb := TORCheckBox(Sender); if cb.Checked then begin FEditingLevel := TRemCoverDataLevel(cb.Tag); if FEditingLevel <> dlUserClass then begin FCurClass := 0; cbxClass.ItemIndex := -1; end; case FEditingLevel of dlDivision: FEditingIEN := FCurDiv; dlService: FEditingIEN := FCurSer; dlLocation: FEditingIEN := FCurLoc; dlUserClass: FEditingIEN := FCurClass; dlUser: FEditingIEN := FCurUser; else FEditingIEN := 0; end; if FEditingIEN = 0 then tmp := ' ' else tmp := ': '; lblEdit.Caption := ' Editing Cover Sheet Reminders for ' + DataName[FEditingLevel] + tmp + GetExternalName(FEditingLevel, FEditingIEN); lvCover.Columns[0].Caption := DataName[FEditingLevel] + ' Level Reminders'; UpdateView; UpdateMasterListView; end else begin FEditingLevel := dlPackage; FEditingIEN := 0; lblEdit.Caption := ''; lvCover.Items.BeginUpdate; try lvCover.Items.Clear; finally lvCover.Items.EndUpdate; end; end; end; procedure TfrmRemCoverSheet.UpdateMasterListView; var i: integer; tmpSL: TStringList; itm: TListItem; begin lvCover.Items.BeginUpdate; try lvCover.Items.Clear; if FEditingLevel <> dlPackage then begin tmpSL := GetCurrent(FEditingIEN, FEditingLevel, FALSE); if assigned(tmpSL) then begin for i := 0 to tmpSL.Count-1 do begin itm := lvCover.Items.Add; SetupItem(itm, tmpSL[i]); end; end; end; finally lvCover.Items.EndUpdate; end; UpdateButtons; end; procedure TfrmRemCoverSheet.UpdateButtons; var ok: boolean; i: integer; Current, Lowest, Highest: integer; begin lvCover.Enabled := (FEditingLevel <> dlPackage); ok := assigned(tvAll.Selected) and (FEditingLevel <> dlPackage); sbCopyRight.Enabled := ok; ok := assigned(lvCover.Selected) and (FEditingLevel <> dlPackage); sbCopyLeft.Enabled := ok; ok := assigned(lvCover.Selected); lblSeq.Enabled := ok; edtSeq.Enabled := ok; FUpdating := TRUE; try udSeq.Enabled := ok; if ok then udSeq.Position := StrToIntDef(lvCover.Selected.SubItems[IdxSeq],1) else udSeq.Position := 1; finally FUpdating := FALSE; end; btnAdd.Enabled := ok; btnRemove.Enabled := ok; btnLock.Enabled := ok and (FEditingLevel <> dlUser); if ok then ok :=(lvCover.Items.Count > 1); Lowest := 99999; Highest := -1; if ok then begin for i := 0 to lvCover.Items.Count-1 do begin Current := StrToIntDef(lvCover.Items[i].SubItems[IdxSeq], 0); if Lowest > Current then Lowest := Current; if Highest < Current then Highest := Current; end; Current := StrToIntDef(lvCover.Selected.SubItems[IdxSeq], 0) end else Current := 0; sbUp.Enabled := ok and (Current > Lowest); sbDown.Enabled := ok and (Current < Highest); end; procedure TfrmRemCoverSheet.tvAllExpanding(Sender: TObject; Node: TTreeNode; var AllowExpansion: Boolean); var List: TORStringList; i, idx: integer; CNode: TORTreeNode; begin if Node.GetFirstChild.Text = DummyNode then begin Node.DeleteChildren; List := GetCatInfo(copy(piece(TORTreeNode(Node).StringData,U,1),2,99)); if assigned(List) then begin for i := 0 to List.Count-1 do begin CNode := TORTreeNode(tvAll.Items.AddChild(Node,'')); CNode.StringData := List[i]; if copy(List[i],1,1) = CVCatCode then begin idx := 1; tvAll.Items.AddChild(CNode, DummyNode); end else idx := 0; CNode.ImageIndex := idx; CNode.SelectedIndex := idx; end; end; end; if FInternalExpansion then AllowExpansion := FALSE else AllowExpansion := Node.HasChildren; end; function TfrmRemCoverSheet.GetCatInfo(CatIEN: string): TORStringList; var i, j, idx: integer; tmp: string; tmpSL: TStrings; begin idx := FCatInfo.IndexOf(CatIEN); if idx < 0 then begin Result := TORStringList.Create; try tmpSL := GetCategoryItems(StrToIntDef(CatIEN,0)); for i := 0 to tmpSL.Count-1 do begin tmp := copy(tmpSL[i],1,1); if tmp = CVCatCode then idx := 3 else idx := 4; tmp := tmp + Piece(tmpSL[i],U,2) + U + Piece(tmpSL[i],U,idx); j := FMasterList.IndexOfPiece(piece(tmp,U,1)); if j >= 0 then tmp := tmp + piece(FMasterList[j],U,3); Result.Add(tmp); end; FCatInfo.AddObject(CatIEN, Result); except Result.Free; raise; end; end else Result := TORStringList(FCatInfo.Objects[idx]); end; procedure TfrmRemCoverSheet.MarkListAsChanged; var tmp: string; idx: integer; begin idx := FData.IndexOfPiece(DataCode[FEditingLevel] + IntToStr(FEditingIEN)); if idx >= 0 then begin tmp := FData[idx]; SetPiece(Tmp,U,2,BoolChar[TRUE]); FData[idx] := tmp; btnApply.Enabled := TRUE; UpdateView; end; end; procedure TfrmRemCoverSheet.edtSeqChange(Sender: TObject); begin if FUpdating or (not FInitialized) then exit; if FBottomSortTag <> 2 then begin FBottomSortTag := 2; lvCover.CustomSort(nil, 0); end; SetSeq(lvCover.Selected, IntToStr(udSeq.Position)); lvCover.CustomSort(nil, 0); UpdateButtons; end; procedure TfrmRemCoverSheet.tvAllExpanded(Sender: TObject; Node: TTreeNode); var idx: integer; begin if Node.Expanded then idx := 2 else idx := 1; Node.ImageIndex := idx; Node.SelectedIndex := idx; end; procedure TfrmRemCoverSheet.tvAllChange(Sender: TObject; Node: TTreeNode); begin UpdateButtons; end; procedure TfrmRemCoverSheet.lvCoverChange(Sender: TObject; Item: TListItem; Change: TItemChange); begin UpdateButtons; end; function TfrmRemCoverSheet.GetIndex(List: TORStringList; Item: TListItem): integer; var IEN: string; begin if assigned(Item) and assigned(List) then begin IEN := Item.SubItems[IdxAdd] + Item.SubItems[IdxIEN]; Result := List.IndexOfPiece(IEN,U,2); end else Result := -1; end; procedure TfrmRemCoverSheet.ChangeStatus(Code: string); var tmpSL: TORStringList; Idx: integer; tmp,p: string; begin tmpSL := GetCurrent(FEditingIEN, FEditingLevel, FALSE); if assigned(tmpSL) then begin Idx := GetIndex(tmpSL, lvCover.Selected); if Idx >= 0 then begin tmp := tmpSL[idx]; p := Piece(tmp,U,2); SetPiece(tmp,U,2,Code + copy(p,2,MaxInt)); tmpSL[idx] := tmp; MarkListAsChanged; SetupItem(lvCover.Selected, tmp); end; end; end; procedure TfrmRemCoverSheet.btnAddClick(Sender: TObject); begin ChangeStatus(CVAddCode); end; procedure TfrmRemCoverSheet.btnRemoveClick(Sender: TObject); begin ChangeStatus(CVRemoveCode); end; procedure TfrmRemCoverSheet.btnLockClick(Sender: TObject); begin ChangeStatus(CVLockCode); end; procedure TfrmRemCoverSheet.lvViewColumnClick(Sender: TObject; Column: TListColumn); begin if FTopSortTag = Column.Tag then FTopSortUp := not FTopSortUp else FTopSortTag := Column.Tag; lvView.CustomSort(nil, 0); end; type TSortData = (sdRem, sdSeq, sdLvl, sdOther); procedure TfrmRemCoverSheet.lvCoverColumnClick(Sender: TObject; Column: TListColumn); begin if FBottomSortTag = Column.Tag then FBottomSortUp := not FBottomSortUp else FBottomSortTag := Column.Tag; lvCover.CustomSort(nil, 0); end; procedure TfrmRemCoverSheet.lvViewCompare(Sender: TObject; Item1, Item2: TListItem; Data: Integer; var Compare: Integer); var i: integer; odr: array[1..4] of TSortData; s1, s2: string; begin odr[1] := TSortData(FTopSortTag-1); case FTopSortTag of 1: begin odr[2] := sdSeq; odr[3] := sdLvl; odr[4] := sdOther; end; 2: begin odr[2] := sdLvl; odr[3] := sdOther; odr[4] := sdRem; end; 3: begin odr[2] := sdOther; odr[3] := sdSeq; odr[4] := sdRem; end; 4: begin odr[2] := sdLvl; odr[3] := sdSeq; odr[4] := sdRem; end; end; Compare := 0; for i := 1 to 4 do begin case odr[i] of sdRem: begin s1 := Item1.Caption; s2 := Item2.Caption; end; sdSeq: begin s1 := RPad(Item1.SubItems[IdxSeq]); s2 := RPad(Item2.SubItems[IdxSeq]); end; sdLvl: begin s1 := Item1.SubItems[IdxLvl2]; s2 := Item2.SubItems[IdxLvl2]; end; sdOther: begin s1 := Item1.SubItems[IdxType]; s2 := Item2.SubItems[IdxType]; end; end; Compare := CompareText(s1, s2); if Compare <> 0 then break; end; if not FTopSortUp then Compare := -Compare; end; procedure TfrmRemCoverSheet.lvCoverCompare(Sender: TObject; Item1, Item2: TListItem; Data: Integer; var Compare: Integer); var i: integer; odr: array[1..2] of TSortData; s1, s2: string; begin case FBottomSortTag of 1: begin odr[1] := sdRem; odr[2] := sdSeq; end; 2: begin odr[1] := sdSeq; odr[2] := sdRem; end; end; Compare := 0; for i := 1 to 2 do begin case odr[i] of sdRem: begin s1 := Item1.Caption; s2 := Item2.Caption; end; sdSeq: begin s1 := RPad(Item1.SubItems[IdxSeq]); s2 := RPad(Item2.SubItems[IdxSeq]); end; end; Compare := CompareText(s1, s2); if Compare <> 0 then break; end; if not FBottomSortUp then Compare := -Compare; end; procedure TfrmRemCoverSheet.sbUpClick(Sender: TObject); var NextItem: TListItem; Seq1, Seq2: string; begin if assigned(lvCover.Selected) then begin if FBottomSortTag <> 2 then begin FBottomSortTag := 2; lvCover.CustomSort(nil, 0); end; if lvCover.Selected.Index > 0 then begin NextItem := lvCover.Items[lvCover.Selected.Index - 1]; Seq1 := NextItem.SubItems[IdxSeq]; Seq2 := lvCover.Selected.SubItems[IdxSeq]; SetSeq(NextItem, Seq2); SetSeq(lvCover.Selected, Seq1); lvCover.CustomSort(nil, 0); UpdateButtons; end; end; end; procedure TfrmRemCoverSheet.sbDownClick(Sender: TObject); var NextItem: TListItem; Seq1, Seq2: string; begin if assigned(lvCover.Selected) then begin if FBottomSortTag <> 2 then begin FBottomSortTag := 2; lvCover.CustomSort(nil, 0); end; if lvCover.Selected.Index < (lvCover.Items.Count-1) then begin NextItem := lvCover.Items[lvCover.Selected.Index + 1]; Seq1 := NextItem.SubItems[IdxSeq]; Seq2 := lvCover.Selected.SubItems[IdxSeq]; SetSeq(NextItem, Seq2); SetSeq(lvCover.Selected, Seq1); lvCover.CustomSort(nil, 0); UpdateButtons; end; end; end; procedure TfrmRemCoverSheet.SetSeq(Item: TListItem; const Value: string); var tmpSL: TORStringList; Idx: integer; tmp: string; begin tmpSL := GetCurrent(FEditingIEN, FEditingLevel, FALSE); if assigned(tmpSL) then begin Idx := GetIndex(tmpSL, Item); if Idx >= 0 then begin tmp := tmpSL[idx]; if(Piece(Tmp,U,1) <> Value) then begin SetPiece(tmp,U,1,Value); tmpSL[idx] := tmp; MarkListAsChanged; SetupItem(Item, tmp); end; end; end; end; procedure TfrmRemCoverSheet.sbCopyRightClick(Sender: TObject); var i: integer; Seq, Cur, Idx: integer; tmpSL: TORStringList; IEN: string; begin if assigned(tvAll.Selected) then begin IEN := Piece(TORTreeNode(tvAll.Selected).StringData, U, 1); if ListHasData(IEN, IdxIEN) then begin ShowMessage('List already contains this Reminder'); exit; end; if lvCover.Items.Count = 0 then Seq := 10 else begin Seq := 0; for i := 0 to lvCover.Items.Count-1 do begin Cur := StrToIntDef(lvCover.Items[i].SubItems[IdxSeq], 0); if Seq < Cur then Seq := Cur; end; inc(Seq,10); if Seq > 999 then begin Seq := 999; while (Seq > 0) and ListHasData(IntToStr(Seq), IdxSeq) do dec(Seq); end; end; if Seq > 0 then begin tmpSL := GetCurrent(FEditingIEN, FEditingLevel, FALSE, TRUE); Idx := tmpSL.IndexOfPiece(IEN,U,2); if Idx < 0 then begin tmpSL.Add(IntToStr(Seq) + U + CVAddCode + TORTreeNode(tvAll.Selected).StringData); MarkListAsChanged; UpdateMasterListView; for i := 0 to lvCover.Items.Count-1 do if IEN = lvCover.Items[i].SubItems[IdxIEN] then begin lvCover.Selected := lvCover.Items[i]; break; end; end; end; end; end; function TfrmRemCoverSheet.ListHasData(Seq: string; SubIdx: integer): boolean; var i: integer; begin Result := FALSE; for i := 0 to lvCover.Items.Count-1 do if Seq = lvCover.Items[i].SubItems[SubIdx] then begin Result := TRUE; break; end; end; procedure TfrmRemCoverSheet.udSeqChangingEx(Sender: TObject; var AllowChange: Boolean; NewValue: Smallint; Direction: TUpDownDirection); begin if FUpdating or (not FInitialized) then exit; if ListHasData(IntToStr(NewValue), IdxSeq) then begin AllowChange := FALSE; case Direction of updUp: udSeq.Position := NewValue + 1; updDown: udSeq.Position := NewValue - 1; end; end; end; procedure TfrmRemCoverSheet.sbCopyLeftClick(Sender: TObject); var idx, Index, i: integer; tmpSL: TORStringList; begin if assigned(lvCover.Selected) then begin tmpSL := GetCurrent(FEditingIEN, FEditingLevel, FALSE); if assigned(tmpSL) then begin Idx := GetIndex(tmpSL, lvCover.Selected); Index := lvCover.Selected.Index; if Idx >= 0 then begin tmpSL.Delete(Idx); MarkListAsChanged; UpdateMasterListView; if lvCover.Items.Count > 0 then begin if Index > 0 then dec(Index); for i := 0 to lvCover.Items.Count-1 do if lvCover.Items[i].Index = Index then begin lvCover.Selected := lvCover.Items[i]; break; end; end; end; end; end; end; procedure TfrmRemCoverSheet.tvAllDblClick(Sender: TObject); begin if sbCopyRight.Enabled then sbCopyRight.Click; end; procedure TfrmRemCoverSheet.btnApplyClick(Sender: TObject); begin SaveData(TRUE); btnApply.Enabled := FALSE; end; procedure TfrmRemCoverSheet.btnOKClick(Sender: TObject); begin SaveData(FALSE); end; procedure TfrmRemCoverSheet.SaveData(FromApply: boolean); var i, j: integer; tmpSL: TORStringList; DeleteIt, DoRefresh: boolean; Level, lvl: TRemCoverDataLevel; ALevel, AClass, Code, IEN: string; begin DoRefresh := FALSE; i := 0; while (i < FData.Count) do begin DeleteIt := FALSE; if(Piece(FData[i],U,2) = BoolChar[TRUE]) then begin tmpSL := TORStringList(FData.Objects[i]); if assigned(tmpSL) then begin Level := dlPackage; Code := copy(FData[i],1,1); for lvl := low(TRemCoverDataLevel) to high(TRemCoverDataLevel) do begin if DataCode[lvl] = Code then begin Level := lvl; break; end; end; if Level <> dlPackage then begin IEN := copy(Piece(FData[i],U,1),2,MaxInt); ALevel := InternalName[Level]; ACLass := ''; case Level of dlDivision, dlService, dlLocation, dlUser: ALevel := ALevel + '.`' + IEN; dlUserClass: AClass := IEN; end; for j := 0 to tmpSL.Count-1 do tmpSL[j] := pieces(tmpSL[j],U,1,2); SetCoverSheetLevelData(ALevel, AClass, tmpSL); tmpSL.Free; DeleteIt := TRUE; FDataSaved := TRUE; DoRefresh := TRUE; end; end; end; if DeleteIt then FData.Delete(i) else inc(i); end; if FromApply and DoRefresh then UpdateMasterListView; end; procedure TfrmRemCoverSheet.lvCoverDblClick(Sender: TObject); begin if sbCopyLeft.Enabled then sbCopyLeft.Click; end; procedure TfrmRemCoverSheet.lvViewClick(Sender: TObject); var lvl: TRemCoverDataLevel; i: integer; ClsName, TIEN, IEN, lvlName: string; ok: boolean; begin if assigned(lvView.Selected) and (not FUpdatingView) then begin FUpdatingView := TRUE; try lvl := TRemCoverDataLevel(StrToIntDef(lvView.Selected.SubItems[IdxLvl2],ord(dlUser))); IEN := lvView.Selected.SubItems[IdxIEN]; lvlName := lvView.Selected.SubItems[IdxLvl]; TIEN := lvView.Selected.SubItems[IdxTIEN]; ClsName := lvView.Selected.SubItems[IdxType]; ok := (lvl <> FEditingLevel); if(not ok) and (lvl = dlUserClass) then ok := (FEditingIEN <> StrToIntDef(TIEN,0)); if (not FUserMode) and ok and (lvl <> dlPackage) then begin case lvl of dlSystem: FUpdatePending := cbSystem; dlDivision: FUpdatePending := cbDivision; dlService: FUpdatePending := cbService; dlLocation: FUpdatePending := cbLocation; dlUserClass: FUpdatePending := cbUserClass; dlUser: FUpdatePending := cbUser; end; if lvl = dlUserClass then begin cbxClass.InitLongList(ClsName); cbxClass.SelectByID(TIEN); FCurClass := cbxClass.ItemIEN; end; cbxDropDownClose(nil); end; if (lvl = FEditingLevel) then begin for i := 0 to lvCover.Items.Count-1 do if IEN = lvCover.Items[i].SubItems[IdxIEN] then begin lvCover.Selected := lvCover.Items[i]; break; end; end; for i := 0 to lvView.Items.Count-1 do begin if (IEN = lvView.Items[i].SubItems[IdxIEN]) and (lvlName = lvView.Items[i].SubItems[IdxLvl]) then begin lvView.Selected := lvView.Items[i]; break; end; end; finally FUpdatingView := FALSE; end; end; end; function TfrmRemCoverSheet.RPad(Str: String): String; begin Result := StringOfChar('0',7-length(Str)) + Str; end; procedure TfrmRemCoverSheet.btnViewClick(Sender: TObject); var frmRemCoverPreview: TfrmRemCoverPreview; CurSortOrder: integer; CurSortDir: boolean; i, idx, SeqCnt: integer; Lvl, LastLvl, tmp, AddCode, IEN, Seq, SortID: string; RemList, LvlList: TORStringList; // IEN^Name^Seq^SortID^Locked ANode: TTreeNode; procedure GetAllChildren(PNode: TTreeNode; const ASeq, ASortID: string); var Node: TTreeNode; begin PNode.Expand(FALSE); Node := PNode.GetFirstChild; while assigned(Node) do begin tmp := TORTreeNode(Node).StringData; if copy(tmp,1,1) = CVCatCode then GetAllChildren(Node, ASeq, ASortID) else begin if RemList.IndexOfPiece(Piece(tmp,u,1)) < 0 then begin SetPiece(tmp,u,3,ASeq); inc(SeqCnt); SortID := copy(ASortID,1,7) + RPad(IntToStr(SeqCnt)) + copy(ASortID,15,MaxInt); SetPiece(tmp,u,4,SortID); RemList.Add(tmp); end; end; Node := Node.GetNextSibling; end; end; begin frmRemCoverPreview := TfrmRemCoverPreview.Create(Application); try CurSortOrder := FTopSortTag; CurSortDir := FTopSortUp; lvView.Items.BeginUpdate; try FTopSortTag := 3; FTopSortUp := TRUE; lvView.CustomSort(nil, 0); RemList := TORStringList.Create; try LvlList := TORStringList.Create; try LastLvl := ''; for i := 0 to lvView.Items.Count-1 do begin Lvl := lvView.Items[i].SubItems[IdxLvl2]; if LvL <> LastLvl then begin RemList.AddStrings(LvlList); LvlList.Clear; LastLvl := Lvl; end; IEN := lvView.Items[i].SubItems[IdxIEN]; AddCode := lvView.Items[i].SubItems[IdxAdd]; idx := RemList.IndexOfPiece(IEN); if AddCode = CVRemoveCode then begin if(idx >= 0) and (piece(RemList[idx],U,5) <> '1') then RemList.Delete(idx); end else begin if idx < 0 then begin Seq := lvView.Items[i].SubItems[IdxSeq]; SortID := RPad(Seq) + '0000000' + lvl + copy(lvView.Items[i].SubItems[IdxTIEN] + '0000000000',1,10); tmp := IEN + U + lvView.Items[i].Caption + U + Seq + U + SortID; if AddCode = CVLockCode then tmp := tmp + U + '1'; RemList.Add(tmp); end else if (AddCode = CVLockCode) and (piece(RemList[idx],U,5) <> '1') then begin tmp := RemList[idx]; SetPiece(tmp,U,5,'1'); RemList[idx] := tmp; end; end; end; RemList.AddStrings(LvlList); FTopSortTag := CurSortOrder; FTopSortUp := CurSortDir; lvView.CustomSort(nil, 0); LvlList.Clear; LvlList.Assign(RemList); RemList.Clear; FInternalExpansion := TRUE; try for i := 0 to LvlList.Count-1 do begin IEN := piece(LvlList[i],U,1); if (copy(LvlList[i],1,1) = CVCatCode) then begin ANode := tvAll.Items.GetFirstNode; while assigned(ANode) do begin if IEN = piece(TORTreeNode(ANode).StringData,U,1) then begin SeqCnt := 0; GetAllChildren(ANode, Piece(LvlList[i], U, 3), Piece(LvlList[i], U, 4)); ANode := nil; end else ANode := ANode.GetNextSibling; end; end else if RemList.IndexOfPiece(IEN) < 0 then RemList.Add(LvlList[i]); end; finally FInternalExpansion := FALSE; end; finally LvlList.Free; end; RemList.SortByPiece(4); for i := 0 to RemList.Count-1 do begin with frmRemCoverPreview.lvMain.Items.Add do begin tmp := RemList[i]; Caption := Piece(tmp, U, 2); SubItems.Add(Piece(tmp, U, 3)); SubItems.Add(Piece(tmp, U, 4)); end; end; finally RemList.Free; end; finally lvView.Items.EndUpdate; end; frmRemCoverPreview.ShowModal; finally frmRemCoverPreview.Free; end; end; procedure TfrmRemCoverSheet.lvCoverKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if (Key = VK_DELETE) and sbCopyLeft.Enabled then sbCopyLeft.Click; end; procedure TfrmRemCoverSheet.edtSeqKeyPress(Sender: TObject; var Key: Char); begin if (Key < '0') or (Key > '9') then Key := #0; end; procedure TfrmRemCoverSheet.cbxDivisionKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if (Key = VK_RETURN) and TORComboBox(Sender).DroppedDown then TORComboBox(Sender).DroppedDown := FALSE; end; function TfrmRemCoverSheet.GetCoverSheetLvlData(ALevel, AClass: string): TStrings; var IEN: string; i, j: integer; begin Result := GetCoverSheetLevelData(ALevel, AClass); for i := 0 to Result.Count-1 do begin IEN := copy(piece(Result[i],U,2),2,MaxInt); j := FMasterList.IndexOfPiece(IEN); if j >= 0 then Result[i] := Result[i] + piece(FMasterList[j],U,3); end; end; end.