diff --git a/Lib/D2006/UnitSwitcherD2006.bpl b/Lib/D2006/UnitSwitcherD2006.bpl new file mode 100644 index 0000000..46a649f Binary files /dev/null and b/Lib/D2006/UnitSwitcherD2006.bpl differ diff --git a/Lib/D7/UnitSwitcherD7.bpl b/Lib/D7/UnitSwitcherD7.bpl new file mode 100644 index 0000000..2409be1 Binary files /dev/null and b/Lib/D7/UnitSwitcherD7.bpl differ diff --git a/Resources/ReadOnly.ico b/Resources/ReadOnly.ico new file mode 100644 index 0000000..06809b3 Binary files /dev/null and b/Resources/ReadOnly.ico differ diff --git a/Source/UnSwDialog.dfm b/Source/UnSwDialog.dfm index a0bfe4f..310c6d1 100644 --- a/Source/UnSwDialog.dfm +++ b/Source/UnSwDialog.dfm @@ -90,6 +90,7 @@ object frmUnSwDialog: TfrmUnSwDialog OnData = lstUnitsData OnDblClick = lstUnitsDblClick OnDrawItem = lstUnitsDrawItem + OnMouseDown = lstUnitsMouseDown end object pnlSubFilters: TPanel Left = 4 @@ -206,7 +207,7 @@ object frmUnSwDialog: TfrmUnSwDialog Left = 16 Top = 264 Bitmap = { - 494C010105000900040010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 + 494C010106000900040010001000FFFFFFFFFF00FFFFFFFFFFFFFFFF424D3600 0000000000003600000028000000400000003000000001002000000000000030 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 @@ -340,7 +341,7 @@ object frmUnSwDialog: TfrmUnSwDialog 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 + 0000C0C0C000C0C0C000C0C0C000C0C0C0000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 @@ -348,7 +349,7 @@ object frmUnSwDialog: TfrmUnSwDialog 8000808080008080800080808000808080008080800080808000808080008080 8000808080000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF000000800000008000C0C0C0000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 @@ -356,7 +357,7 @@ object frmUnSwDialog: TfrmUnSwDialog C000FFFFFF00C0C0C000FFFFFF00C0C0C000FFFFFF00C0C0C000FFFFFF00C0C0 C000808080000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF000000FF0000008000C0C0C0000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 @@ -364,7 +365,7 @@ object frmUnSwDialog: TfrmUnSwDialog FF00C0C0C000FFFFFF00C0C0C000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF00FFFFFF00FFFFFF00C0C0C0000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 @@ -372,7 +373,7 @@ object frmUnSwDialog: TfrmUnSwDialog C000FFFFFF00C0C0C000FFFFFF0000000000FFFFFF0080808000808080008080 8000808080008080800080808000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF000000800000008000C0C0C0000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 @@ -380,7 +381,7 @@ object frmUnSwDialog: TfrmUnSwDialog FF00C0C0C000FFFFFF00C0C0C00000000000FFFFFF00FFFFFF00C0C0C000FFFF FF00C0C0C000FFFFFF0080808000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF000000FF0000008000C0C0C0000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 @@ -388,7 +389,7 @@ object frmUnSwDialog: TfrmUnSwDialog C000FFFFFF00C0C0C000FFFFFF0000000000FFFFFF00C0C0C000FFFFFF00C0C0 C000FFFFFF00C0C0C00080808000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF000000FF0000008000C0C0C0000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 @@ -396,7 +397,7 @@ object frmUnSwDialog: TfrmUnSwDialog FF00C0C0C000FFFFFF00C0C0C00000000000FFFFFF00FFFFFF00FFFFFF00FFFF FF00FFFFFF00FFFFFF00FFFFFF00000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF000000FF0000008000C0C0C0000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 @@ -404,7 +405,7 @@ object frmUnSwDialog: TfrmUnSwDialog C000FFFFFF00C0C0C000FFFFFF00000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF000000FF0000008000C0C0C0000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 @@ -412,7 +413,7 @@ object frmUnSwDialog: TfrmUnSwDialog FF00C0C0C000FFFFFF00C0C0C00000000000FF000000FF000000FF000000FF00 0000FF00000000000000C0C0C000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF000000FF0000008000C0C0C0000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 @@ -420,7 +421,7 @@ object frmUnSwDialog: TfrmUnSwDialog C000FFFFFF00C0C0C000FFFFFF00000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 + 0000FFFFFF00FFFFFF00FFFFFF00C0C0C0000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 @@ -598,16 +599,15 @@ object frmUnSwDialog: TfrmUnSwDialog 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000030000000000000003000000000000 - 0003000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000000000000000000000000000000000000000000000000 - 0000000000000000000300000000000000030000000000000003000000000000 - 00030000000000000003000000000000E000E000FFFFEC0FE000E000FFFF840F + 000000000000000000000000000000000003FFF0000000000003FFF000000000 + 0003FFF0000000000000FFF0000000000000FFF0000000000000FFF000000000 + 0000FFF0000000000000FFF0000000000000FFF0000000000000FFF000000000 + 0000FFF0000000000003FFFF000000000003FFFF000000000003FFFF00000000 + 0003FFFF000000000003FFFF00000000E000E000FFFFEC0FE000E000FFFF840F E000E0000000AC0FE000E0000000BF3FE000E0000000FFFFE000600000001000 E000200000001000E00000000000B000E00020000000F000E00060000000F000 E000E0000000F000E000E0000000F000E000E0000000F000E001E0010000F000 - E003E003FFFFF000E007E007FFFFF00000000000000000000000000000000000 - 000000000000} + E003E003FFFFF000E007E007FFFFF000} end object alMain: TActionList Left = 44 @@ -659,9 +659,13 @@ object frmUnSwDialog: TfrmUnSwDialog ShortCut = 16424 OnExecute = actMRUNextExecute end + object actReadOnly: TAction + Caption = '&Read only' + ShortCut = 49234 + OnExecute = actReadOnlyExecute + end end object pmnUnits: TPopupMenu - OnPopup = pmnUnitsPopup Left = 72 Top = 264 object pmnUnitsSelectAll: TMenuItem @@ -682,6 +686,12 @@ object frmUnSwDialog: TfrmUnSwDialog object pmnUnitsSep2: TMenuItem Caption = '-' end + object pmnUnitsReadOnly: TMenuItem + Action = actReadOnly + end + object pmnUnitsSep3: TMenuItem + Caption = '-' + end object pmnUnitsOpenFolder: TMenuItem Action = actOpenFolder end diff --git a/Source/UnSwDialog.pas b/Source/UnSwDialog.pas index d524197..fa91844 100644 --- a/Source/UnSwDialog.pas +++ b/Source/UnSwDialog.pas @@ -30,12 +30,15 @@ type private FColor: TColor; FImageIndex: Integer; + FOverlayIndex: Integer; protected + procedure VisitUnit(const AUnit: TUnSwUnit); procedure VisitModule(const AUnit: TUnSwModuleUnit); procedure VisitProject(const AUnit: TUnSwProjectUnit); public property Color: TColor read FColor; property ImageIndex: Integer read FImageIndex; + property OverlayIndex: Integer read FOverlayIndex; end; TfrmUnSwDialog = class(TForm) @@ -44,6 +47,7 @@ type actOpenDFMProperties: TAction; actOpenFolder: TAction; actOpenProperties: TAction; + actReadOnly: TAction; actSelectAll: TAction; actSelectInvert: TAction; actSortByName: TAction; @@ -64,10 +68,12 @@ type pmnUnitsOpenDFMProperties: TMenuItem; pmnUnitsOpenFolder: TMenuItem; pmnUnitsOpenProperties: TMenuItem; + pmnUnitsReadOnly: TMenuItem; pmnUnitsSelectAll: TMenuItem; pmnUnitsSelectInvert: TMenuItem; pmnUnitsSep1: TMenuItem; pmnUnitsSep2: TMenuItem; + pmnUnitsSep3: TMenuItem; pmnUnitsSortByName: TMenuItem; pmnUnitsSortByType: TMenuItem; pnlButtons: TPanel; @@ -82,6 +88,7 @@ type procedure actOpenDFMPropertiesExecute(Sender: TObject); procedure actOpenFolderExecute(Sender: TObject); procedure actOpenPropertiesExecute(Sender: TObject); + procedure actReadOnlyExecute(Sender: TObject); procedure actSelectAllExecute(Sender: TObject); procedure actSelectInvertExecute(Sender: TObject); procedure btnConfigurationClick(Sender: TObject); @@ -94,7 +101,7 @@ type procedure lstUnitsData(Control: TWinControl; Index: Integer; var Data: string); procedure lstUnitsDblClick(Sender: TObject); procedure lstUnitsDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); - procedure pmnUnitsPopup(Sender: TObject); + procedure lstUnitsMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure SortExecute(Sender: TObject); procedure TypeFilterChange(Sender: TObject); private @@ -129,6 +136,8 @@ type procedure LoadSettings(); procedure SaveSettings(); + + procedure UpdateUnitActions(); public class function Execute(const AUnits: TUnSwUnitList; const AFormsOnly: Boolean; @@ -184,10 +193,29 @@ type property ReadOnlyCount: Integer read FReadOnlyCount; end; + TUnSwSetReadOnlyVisitor = class(TUnSwOpenVisitor) + private + FReadOnlyFlag: Boolean; + protected + procedure OpenFile(const AFileName: String); override; + public + property ReadOnlyFlag: Boolean read FReadOnlyFlag write FReadOnlyFlag; + end; + {$R *.dfm} +function IsReadOnly(const AFileName: String): Boolean; +var + iAttr: Integer; + +begin + iAttr := FileGetAttr(AFileName); + Result := (iAttr <> -1) and ((iAttr and faReadOnly) <> 0); +end; + + { TUnSwOpenVisitor } constructor TUnSwOpenVisitor.Create(); begin @@ -207,9 +235,13 @@ end; function TUnSwOpenVisitor.IsProcessed(const AFileName: String; const ARegister: Boolean): Boolean; begin - Result := (FProcessed.IndexOf(AFileName) > -1); - if (not Result) and ARegister then - FProcessed.Add(AFileName); + Result := True; + if FileExists(AFileName) or DirectoryExists(AFileName) then + begin + Result := (FProcessed.IndexOf(AFileName) > -1); + if (not Result) and ARegister then + FProcessed.Add(AFileName); + end; end; procedure TUnSwOpenVisitor.VisitModule(const AUnit: TUnSwModuleUnit); @@ -238,7 +270,7 @@ begin sParams := '/e,'; // If it's a file, have explorer highlight it - if not DirectoryExists(AFileName) then + if not DirectoryExists(sFile) then sParams := sParams + '/select,'; sParams := sParams + ExtractShortPathName(sFile); @@ -280,22 +312,57 @@ end; { TUnSwReadOnlyVisitor } procedure TUnSwReadOnlyVisitor.OpenFile(const AFileName: String); +begin + if not IsProcessed(AFileName) then + if IsReadOnly(AFileName) then + Inc(FReadOnlyCount); +end; + + +{ TUnSwSetReadOnlyVisitor } +procedure TUnSwSetReadOnlyVisitor.OpenFile(const AFileName: String); var - iAttr: Integer; + fileInfo: TSearchRec; + fileAttr: Integer; + path: String; begin if not IsProcessed(AFileName) then begin - iAttr := FileGetAttr(AFileName); - if (iAttr and faReadOnly) <> 0 then - Inc(FReadOnlyCount); + path := ExtractFilePath(AFileName); + if FindFirst(ChangeFileExt(AFileName, '.*'), faAnyFile, fileInfo) = 0 then + begin + repeat + fileAttr := FileGetAttr(path + fileInfo.Name); + if fileAttr <> -1 then + begin + if ReadOnlyFlag then + fileAttr := fileAttr or faReadOnly + else + fileAttr := fileAttr and not faReadOnly; + + FileSetAttr(path + fileInfo.Name, fileAttr); + end; + until FindNext(fileInfo) <> 0; + + FindClose(fileInfo); + end; end; end; { TUnSwStyleVisitor } +procedure TUnSwStyleVisitor.VisitUnit(const AUnit: TUnSwUnit); +begin + if IsReadOnly(AUnit.FileName) then + FOverlayIndex := 5 + else + FOverlayIndex := -1; +end; + procedure TUnSwStyleVisitor.VisitModule(const AUnit: TUnSwModuleUnit); begin + VisitUnit(AUnit); case AUnit.UnitType of swutUnit: begin @@ -320,8 +387,9 @@ end; procedure TUnSwStyleVisitor.VisitProject(const AUnit: TUnSwProjectUnit); begin - FColor := Settings.Colors.ProjectSource; - FImageIndex := 4; + VisitUnit(AUnit); + FColor := Settings.Colors.ProjectSource; + FImageIndex := 4; end; @@ -421,6 +489,66 @@ begin end; end; +procedure TfrmUnSwDialog.UpdateUnitActions(); +var + bDFM: Boolean; + bUnits: Boolean; + iUnit: Integer; + pUnits: TUnSwUnitList; + pVisitor: TUnSwReadOnlyVisitor; + sStatus: String; + +begin + { Read-only status } + pUnits := GetActiveUnits(); + if Assigned(pUnits) then + try + pVisitor := TUnSwReadOnlyVisitor.Create(); + try + pUnits.AcceptVisitor(pVisitor); + actReadOnly.Checked := (pVisitor.ReadOnlyCount > 0); + + sStatus := ''; + if pVisitor.ReadOnlyCount > 0 then + if pVisitor.ReadOnlyCount = 1 then + sStatus := '1 read-only unit selected' + else + sStatus := Format('%d read-only units selected', + [pVisitor.ReadOnlyCount]); + + sbStatus.Panels[0].Text := sStatus; + finally + FreeAndNil(pVisitor); + end; + finally + FreeAndNil(pUnits); + end; + + { Properties } + bDFM := False; + bUnits := False; + + pUnits := GetActiveUnits(); + if Assigned(pUnits) then + try + bUnits := (pUnits.Count > 0); + + for iUnit := 0 to Pred(pUnits.Count) do + if (pUnits[iUnit] is TUnSwModuleUnit) and + (TUnSwModuleUnit(pUnits[iUnit]).UnitType in [swutForm, swutDataModule]) then + begin + bDFM := True; + break; + end; + finally + FreeAndNil(pUnits); + end; + + actOpenFolder.Enabled := bUnits; + actOpenProperties.Enabled := bUnits; + actOpenDFMProperties.Enabled := bDFM; +end; + procedure TfrmUnSwDialog.UpdateList(); var activeUnit: TUnSwUnit; @@ -689,6 +817,9 @@ begin cmbSearch.ItemIndex := FMRUIndex; ActiveControl := cmbSearch; cmbSearch.SelectAll(); + + if Assigned(cmbSearch.OnChange) then + cmbSearch.OnChange(nil); end; procedure TfrmUnSwDialog.actMRUNextExecute(Sender: TObject); @@ -810,34 +941,8 @@ begin end; procedure TfrmUnSwDialog.lstUnitsClick(Sender: TObject); -var - pUnits: TUnSwUnitList; - pVisitor: TUnSwReadOnlyVisitor; - sStatus: String; - begin - pUnits := GetActiveUnits(); - if Assigned(pUnits) then - try - pVisitor := TUnSwReadOnlyVisitor.Create(); - try - pUnits.AcceptVisitor(pVisitor); - - sStatus := ''; - if pVisitor.ReadOnlyCount > 0 then - if pVisitor.ReadOnlyCount = 1 then - sStatus := '1 read-only unit selected' - else - sStatus := Format('%d read-only units selected', - [pVisitor.ReadOnlyCount]); - - sbStatus.Panels[0].Text := sStatus; - finally - FreeAndNil(pVisitor); - end; - finally - FreeAndNil(pUnits); - end; + UpdateUnitActions(); end; procedure TfrmUnSwDialog.lstUnitsData(Control: TWinControl; Index: Integer; @@ -882,42 +987,56 @@ begin InflateRect(textRect, -2, -2); ilsTypes.Draw(Canvas, textRect.Left, textRect.Top, FStyleVisitor.ImageIndex); + if FStyleVisitor.OverlayIndex > -1 then + ilsTypes.Draw(Canvas, textRect.Left, textRect.Top, FStyleVisitor.OverlayIndex); + Inc(textRect.Left, ilsTypes.Width + 4); DrawText(Canvas.Handle, PChar(text), Length(text), textRect, DT_SINGLELINE or DT_LEFT or DT_VCENTER or DT_END_ELLIPSIS); end; end; -procedure TfrmUnSwDialog.pmnUnitsPopup(Sender: TObject); +procedure TfrmUnSwDialog.lstUnitsMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var - bDFM: Boolean; - bUnits: Boolean; - iUnit: Integer; - pUnits: TUnSwUnitList; + itemIndex: Integer; begin - bDFM := False; - bUnits := False; + { Bij rechtermuisknop het item selecteren indien deze niet al + geselecteerd was } + if Button = mbRight then + begin + itemIndex := lstUnits.ItemAtPos(Point(X, Y), True); + if (itemIndex > -1) and (not lstUnits.Selected[itemIndex]) then + begin + lstUnits.ClearSelection; + lstUnits.Selected[itemIndex] := True; + UpdateUnitActions(); + end; + end; +end; - pUnits := GetActiveUnits(); +procedure TfrmUnSwDialog.actReadOnlyExecute(Sender: TObject); +var + pUnits: TUnSwUnitList; + pVisitor: TUnSwSetReadOnlyVisitor; + +begin + pUnits := GetActiveUnits(); if Assigned(pUnits) then try - bUnits := (pUnits.Count > 0); - - for iUnit := 0 to Pred(pUnits.Count) do - if (pUnits[iUnit] is TUnSwModuleUnit) and - (TUnSwModuleUnit(pUnits[iUnit]).UnitType in [swutForm, swutDataModule]) then - begin - bDFM := True; - break; - end; + pVisitor := TUnSwSetReadOnlyVisitor.Create(); + try + pVisitor.ReadOnlyFlag := not actReadOnly.Checked; + pUnits.AcceptVisitor(pVisitor); + finally + FreeAndNil(pVisitor); + end; finally FreeAndNil(pUnits); + + lstUnits.Invalidate(); + UpdateUnitActions(); end; - - actOpenFolder.Enabled := bUnits; - actOpenProperties.Enabled := bUnits; - actOpenDFMProperties.Enabled := bDFM; end; end.