unit UnSwDialog; interface uses Classes, ComCtrls, Controls, ExtCtrls, Forms, ImgList, StdCtrls, Windows, UnSwObjects, UnSwFilters; type TUnSwIconVisitor = class(TUnSwNoRefIntfObject, IUnSwVisitor) private FImageIndex: Integer; protected procedure VisitModule(const AUnit: TUnSwModuleUnit); procedure VisitProject(const AUnit: TUnSwProjectUnit); public property ImageIndex: Integer read FImageIndex; end; TfrmUnSwDialog = class(TForm) btnCancel: TButton; btnOK: TButton; chkDataModules: TCheckBox; chkForms: TCheckBox; chkProjectSource: TCheckBox; edtSearch: TEdit; ilsTypes: TImageList; lstUnits: TListBox; pnlButtons: TPanel; pnlIncludeTypes: TPanel; pnlMain: TPanel; pnlSearch: TPanel; sbStatus: TStatusBar; procedure edtSearchChange(Sender: TObject); procedure edtSearchKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure TypeFilterChange(Sender: TObject); procedure lstUnitsData(Control: TWinControl; Index: Integer; var Data: string); procedure lstUnitsDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); private FLoading: Boolean; FUnitList: TUnSwUnitList; FActiveUnit: TUnSwUnit; FFormsOnly: Boolean; FTypeFilteredList: TUnSwUnitList; FInputFilteredList: TUnSwUnitList; FTypeFilter: TUnSwUnitTypeFilter; FInputFilter: TUnSwUnitSimpleFilter; FIconVisitor: TUnSwIconVisitor; function InternalExecute(): TUnSwUnit; procedure UpdateTypeFilter(); procedure UpdateList(); function GetActiveUnit(): TUnSwUnit; procedure LoadSettings(); procedure SaveSettings(); public class function Execute(const AUnits: TUnSwUnitList; const AFormsOnly: Boolean; const AActive: TUnSwUnit = nil): TUnSwUnit; end; implementation uses Graphics, Messages, SysUtils; {$R *.dfm} { TUnSwIconVisitor } procedure TUnSwIconVisitor.VisitModule(const AUnit: TUnSwModuleUnit); begin case AUnit.UnitType of swutUnit: FImageIndex := 1; swutForm: FImageIndex := 2; swutDataModule: FImageIndex := 3; else FImageIndex := 0; end; end; procedure TUnSwIconVisitor.VisitProject(const AUnit: TUnSwProjectUnit); begin FImageIndex := 4; end; { TfrmUnSwDialog } class function TfrmUnSwDialog.Execute(const AUnits: TUnSwUnitList; const AFormsOnly: Boolean; const AActive: TUnSwUnit): TUnSwUnit; begin with Self.Create(nil) do try FUnitList := AUnits; FActiveUnit := AActive; FFormsOnly := AFormsOnly; Result := InternalExecute(); finally Free(); end; end; function SortByName(Item1, Item2: Pointer): Integer; begin Result := CompareText(TUnSwUnit(Item1).Name, TUnSwUnit(Item2).Name) end; function TfrmUnSwDialog.InternalExecute(): TUnSwUnit; begin Result := nil; FTypeFilteredList := TUnSwUnitList.Create(); FInputFilteredList := TUnSwUnitList.Create(); FTypeFilter := TUnSwUnitTypeFilter.Create(FTypeFilteredList); if FFormsOnly then FInputFilter := TUnSwUnitSimpleFormNameFilter.Create(FInputFilteredList) else FInputFilter := TUnSwUnitSimpleNameFilter.Create(FInputFilteredList); try LoadSettings(); if FFormsOnly then pnlIncludeTypes.Visible := False; UpdateTypeFilter(); FIconVisitor := TUnSwIconVisitor.Create(); try if Self.ShowModal() = mrOk then Result := GetActiveUnit(); SaveSettings(); finally FreeAndNil(FIconVisitor); end; finally FreeAndNil(FInputFilter); FreeAndNil(FTypeFilter); FreeAndNil(FInputFilteredList); FreeAndNil(FTypeFilteredList); end; end; procedure TfrmUnSwDialog.UpdateList(); var pActive: TUnSwUnit; begin pActive := GetActiveUnit(); FInputFilteredList.Clone(FTypeFilteredList); FInputFilteredList.AcceptVisitor(FInputFilter); lstUnits.Count := FInputFilteredList.Count; if FInputFilteredList.Count > 0 then begin if Assigned(pActive) then lstUnits.ItemIndex := FInputFilteredList.IndexOf(pActive); if lstUnits.ItemIndex = -1 then lstUnits.ItemIndex := 0; end; end; procedure TfrmUnSwDialog.UpdateTypeFilter(); begin FTypeFilter.IncludeUnits := not FFormsOnly; FTypeFilter.IncludeForms := (FFormsOnly or chkForms.Checked); FTypeFilter.IncludeDataModules := (FFormsOnly or chkDataModules.Checked); FTypeFilter.IncludeProjectSource := ((not FFormsOnly) and chkProjectSource.Checked); FTypeFilteredList.Clone(FUnitList); FTypeFilteredList.AcceptVisitor(FTypeFilter); FTypeFilteredList.Sort(SortByName); UpdateList(); end; function TfrmUnSwDialog.GetActiveUnit(): TUnSwUnit; begin Result := FActiveUnit; if not Assigned(Result) then begin if lstUnits.ItemIndex > -1 then Result := FInputFilteredList[lstUnits.ItemIndex]; end else FActiveUnit := nil; end; procedure TfrmUnSwDialog.LoadSettings(); var pSettings: TUnSwRegistry; function ReadBoolDef(const AName: String; const ADefault: Boolean): Boolean; begin if pSettings.ValueExists(AName) then Result := pSettings.ReadBool(AName) else Result := ADefault; end; function ReadIntegerDef(const AName: String; const ADefault: Integer): Integer; begin if pSettings.ValueExists(AName) then Result := pSettings.ReadInteger(AName) else Result := ADefault; end; var sKey: String; begin pSettings := TUnSwRegistry.Create(); with pSettings do try FLoading := True; RootKey := HKEY_CURRENT_USER; if OpenIDEKey() then begin chkForms.Checked := ReadBoolDef('IncludeForms', FTypeFilter.IncludeForms); chkDataModules.Checked := ReadBoolDef('IncludeDataModules', FTypeFilter.IncludeDataModules); chkProjectSource.Checked := ReadBoolDef('IncludeProjectSource', FTypeFilter.IncludeProjectSource); if FFormsOnly then sKey := 'Forms' else sKey := 'Units'; Self.ClientWidth := ReadIntegerDef(sKey + 'DialogWidth', Self.ClientWidth); Self.ClientHeight := ReadIntegerDef(sKey + 'DialogHeight', Self.ClientHeight); Self.Caption := 'UnitSwitcher - View ' + sKey; CloseKey(); end; finally FLoading := False; FreeAndNil(pSettings); end; end; procedure TfrmUnSwDialog.SaveSettings(); var sKey: String; begin with TUnSwRegistry.Create() do try FLoading := True; RootKey := HKEY_CURRENT_USER; if OpenIDEKey() then begin WriteBool('IncludeForms', chkForms.Checked); WriteBool('IncludeDataModules', chkDataModules.Checked); WriteBool('IncludeProjectSource', chkProjectSource.Checked); if FFormsOnly then sKey := 'Forms' else sKey := 'Units'; WriteInteger(sKey + 'DialogWidth', Self.ClientWidth); WriteInteger(sKey + 'DialogHeight', Self.ClientHeight); CloseKey(); end; finally FLoading := False; Free(); end; end; procedure TfrmUnSwDialog.edtSearchChange(Sender: TObject); begin FInputFilter.Filter := edtSearch.Text; UpdateList(); end; procedure TfrmUnSwDialog.edtSearchKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if (Shift = []) and (Key in [VK_UP, VK_DOWN, VK_PRIOR, VK_NEXT]) then lstUnits.Perform(WM_KEYDOWN, Key, 0); end; procedure TfrmUnSwDialog.TypeFilterChange(Sender: TObject); begin if not FLoading then UpdateTypeFilter(); end; procedure TfrmUnSwDialog.lstUnitsData(Control: TWinControl; Index: Integer; var Data: string); begin Data := FInputFilteredList[Index].Name; end; procedure TfrmUnSwDialog.lstUnitsDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); var pUnit: TUnSwUnit; rText: TRect; sText: String; begin with TListBox(Control) do begin pUnit := FInputFilteredList[Index]; if FFormsOnly and (pUnit is TUnSwModuleUnit) then sText := TUnSwModuleUnit(pUnit).FormName else sText := pUnit.Name; if odSelected in State then begin Canvas.Brush.Color := clHighlight; Canvas.Font.Color := clHighlightText; end else begin Canvas.Brush.Color := clWindow; Canvas.Font.Color := clWindowText; end; Canvas.FillRect(Rect); rText := Rect; InflateRect(rText, -2, -2); pUnit.AcceptVisitor(FIconVisitor); ilsTypes.Draw(Canvas, rText.Left, rText.Top, FIconVisitor.ImageIndex); Inc(rText.Left, ilsTypes.Width + 4); DrawText(Canvas.Handle, PChar(sText), Length(sText), rText, DT_SINGLELINE or DT_LEFT or DT_VCENTER or DT_END_ELLIPSIS); end; end; end.