2012-06-08 14 views
7

Używam w moim programie , chciałbym dodać pionowy pasek przewijania w nim i móc ustawić jego rozmiar (powiedzmy 10 widocznych elementów) i obsłużyć zdarzenia przesuwając suwak paska przewijania (po kliknięciu na przyciski lub po przewijanie kółka myszy). Chciałbym wiedzieć, że komponenty z tą funkcjonalnością istnieją, lub będę zadowolony z teorii na temat tworzenia tego komponentu. Na przykład, potrzebuję zachowania podobnego do menu kontekstowego w pasku adresu Vista/7 Explorer (z listą podfolderów w bieżącym folderze)Jak utworzyć wyskakujące menu za pomocą paska przewijania?

Dzięki.

+0

Zobacz http://stackoverflow.com/questions/6203217/is-there-an-edit-control-for-delphi-that-allows-path-editing –

+0

OK, przeglądałem komponenty w tym temacie, ale wszystkie z nich użyj standardowego TPopupMenu, aby wyświetlić listę podfolderów. Standardowe TPopupMenu z dużą liczbą elementów rozszerza pełną wysokość ekranu, a gdy poziom jest niski, strzałki stają się widoczne na górze i dole menu, a po ich kliknięciu menu przewija się w górę lub w dół. To zachowanie mi nie odpowiada. Chcę przewijać menu za pomocą pionowego paska przewijania. Czy to możliwe? – Lumen

+0

Nie sądzę, myślę, że explorer w ogóle nie korzysta z menu z breadcrumb, choć nie jestem tego pewien. –

Odpowiedz

11

Aktualizacja:

Poniższy kod pokazuje jak rozszerzyć standardowego menu kontekstowego, aby pokazać swoją formę podręczne zamiast prawdziwego menu. Pozycje menu są wyświetlane na liście z wartością DrawMenuItem, z uwzględnieniem niestandardowego rysunku elementów (jeśli są). Również pomiar wysokości przedmiotu jest brany pod uwagę, więc wysokość przedmiotu powinna być taka sama, jak w przypadku korzystania ze standardowego menu. Następujące właściwości zostały wprowadzone do kontroli TPopupMenu:

  • PopupForm - jest obowiązkowe nieruchomość, która ma być ustawiona podczas korzystania z trybu niestandardowego i jest to forma, która musi zachować ostrość podczas popup menu
  • PopupMode - przełącza tryb normalny i specjalny (domyślnie jest pmStandard)
    - pm Custom - użyje niestandardowego formularza zamiast standardowego menu podręcznego
    - pmStandard - użyje standardowego menu podręcznego i zignoruje wszystkie nowe właściwości
  • PopupCount - jest liczbą elementów wyświetlanych po wyświetleniu menu, ma on podobne znaczenie jak DropDownCount w polu kombi (domyślnie 5)

Jak przedłużyć kontrolę menu:

utworzyć pustą formę i nazwę go jako TPopupForm, jednostkę Zapisz PopupUnit i kopiuj, wklej następujący kod i zapisz go ponownie:

unit PopupUnit; 

interface 

uses 
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
    Dialogs, StdCtrls, Menus; 

type 
    TPopupMode = (pmStandard, pmCustom); 
    TPopupMenu = class(Menus.TPopupMenu) 
    private 
    FPopupForm: TForm; 
    FPopupMode: TPopupMode; 
    FPopupCount: Integer; 
    public 
    constructor Create(AOwner: TComponent); override; 
    procedure Popup(X, Y: Integer); override; 
    property PopupForm: TForm read FPopupForm write FPopupForm; 
    property PopupMode: TPopupMode read FPopupMode write FPopupMode; 
    property PopupCount: Integer read FPopupCount write FPopupCount; 
    end; 

type 
    TMenuItem = class(Menus.TMenuItem) 
    end; 
    TPopupForm = class(TForm) 
    private 
    FListBox: TListBox; 
    FPopupForm: TForm; 
    FPopupMenu: TPopupMenu; 
    FPopupCount: Integer; 
    procedure WMActivate(var AMessage: TWMActivate); message WM_ACTIVATE; 
    procedure ListBoxDrawItem(Control: TWinControl; Index: Integer; 
     Rect: TRect; State: TOwnerDrawState); 
    procedure ListBoxMeasureItem(Control: TWinControl; Index: Integer; 
     var Height: Integer); 
    procedure ListBoxMouseDown(Sender: TObject; Button: TMouseButton; 
     Shift: TShiftState; X, Y: Integer); 
    procedure ListBoxMouseUp(Sender: TObject; Button: TMouseButton; 
     Shift: TShiftState; X, Y: Integer); 
    procedure ListBoxMouseMove(Sender: TObject; Shift: TShiftState; X, 
     Y: Integer); 
    procedure ListBoxKeyDown(Sender: TObject; var Key: Word; 
     Shift: TShiftState); 
    protected 
    procedure Paint; override; 
    procedure CreateParams(var Params: TCreateParams); override; 
    public 
    constructor Create(AOwner: TComponent; APopupForm: TForm; 
     APopupMenu: TPopupMenu; APopupCount: Integer); reintroduce; 
    end; 

var 
    PopupForm: TPopupForm; 

implementation 

{$R *.dfm} 

{ TPopupForm } 

constructor TPopupForm.Create(AOwner: TComponent; APopupForm: TForm; 
    APopupMenu: TPopupMenu; APopupCount: Integer); 
var 
    I: Integer; 
    MaxWidth: Integer; 
    MaxHeight: Integer; 
    ItemWidth: Integer; 
    ItemHeight: Integer; 
begin 
    inherited Create(AOwner); 
    BorderStyle := bsNone; 

    FPopupForm := APopupForm; 
    FPopupMenu := APopupMenu; 
    FPopupCount := APopupCount; 

    FListBox := TListBox.Create(Self); 
    FListBox.Parent := Self; 
    FListBox.BorderStyle := bsNone; 
    FListBox.Style := lbOwnerDrawVariable; 
    FListBox.Color := clMenu; 
    FListBox.Top := 2; 
    FListBox.Left := 2; 

    MaxWidth := 0; 
    MaxHeight := 0; 

    FListBox.Items.BeginUpdate; 
    try 
    FListBox.Items.Clear; 
    for I := 0 to FPopupMenu.Items.Count - 1 do 
    begin 
     TMenuItem(FPopupMenu.Items[I]).MeasureItem(FListBox.Canvas, ItemWidth, 
     ItemHeight); 
     if ItemWidth > MaxWidth then 
     MaxWidth := ItemWidth; 
     if I < FPopupCount then 
     MaxHeight := MaxHeight + ItemHeight; 
     FListBox.Items.Add(''); 
    end; 
    finally 
    FListBox.Items.EndUpdate; 
    end; 
    if FPopupMenu.Items.Count > FPopupCount then 
    MaxWidth := MaxWidth + GetSystemMetrics(SM_CXVSCROLL) + 16; 

    FListBox.Width := MaxWidth; 
    FListBox.Height := MaxHeight; 
    FListBox.ItemHeight := ItemHeight; 
    FListBox.OnMouseDown := ListBoxMouseDown; 
    FListBox.OnMouseUp := ListBoxMouseUp; 
    FListBox.OnDrawItem := ListBoxDrawItem; 
    FListBox.OnKeyDown := ListBoxKeyDown; 
    FListBox.OnMeasureItem := ListBoxMeasureItem; 
    FListBox.OnMouseMove := ListBoxMouseMove; 

    ClientWidth := FListBox.Width + 4; 
    ClientHeight := FListBox.Height + 4; 
end; 

procedure TPopupForm.CreateParams(var Params: TCreateParams); 
begin 
    inherited; 
    Params.WindowClass.Style := Params.WindowClass.Style or CS_DROPSHADOW; 
end; 

procedure TPopupForm.ListBoxDrawItem(Control: TWinControl; Index: Integer; 
    Rect: TRect; State: TOwnerDrawState); 
begin 
    DrawMenuItem(FPopupMenu.Items[Index], FListBox.Canvas, Rect, State); 
end; 

procedure TPopupForm.ListBoxKeyDown(Sender: TObject; var Key: Word; 
    Shift: TShiftState); 
begin 
    case Key of 
    VK_ESCAPE: Close; 
    VK_RETURN: 
    begin 
     Close; 
     if FListBox.ItemIndex <> -1 then 
     FPopupMenu.Items[FListBox.ItemIndex].Click; 
    end; 
    end; 
end; 

procedure TPopupForm.ListBoxMeasureItem(Control: TWinControl; Index: Integer; 
    var Height: Integer); 
var 
    ItemWidth: Integer; 
begin 
    TMenuItem(FPopupMenu.Items[Index]).MeasureItem(FListBox.Canvas, ItemWidth, 
    Height); 
end; 

procedure TPopupForm.ListBoxMouseDown(Sender: TObject; Button: TMouseButton; 
    Shift: TShiftState; X, Y: Integer); 
begin 
    SetCapture(FListBox.Handle); 
end; 

procedure TPopupForm.ListBoxMouseMove(Sender: TObject; Shift: TShiftState; X, 
    Y: Integer); 
var 
    ItemIndex: Integer; 
begin 
    ItemIndex := FListBox.ItemAtPos(Point(X, Y), True); 
    if ItemIndex <> FListBox.ItemIndex then 
    FListBox.ItemIndex := ItemIndex; 
end; 

procedure TPopupForm.ListBoxMouseUp(Sender: TObject; Button: TMouseButton; 
    Shift: TShiftState; X, Y: Integer); 
begin 
    Close; 
    if FListBox.ItemIndex <> -1 then 
    FPopupMenu.Items[FListBox.ItemIndex].Click; 
end; 

procedure TPopupForm.Paint; 
begin 
    inherited; 
    Canvas.Pen.Color := clSilver; 
    Canvas.Rectangle(ClientRect); 
end; 

procedure TPopupForm.WMActivate(var AMessage: TWMActivate); 
begin 
    SendMessage(FPopupForm.Handle, WM_NCACTIVATE, 1, 0); 
    inherited; 
    if AMessage.Active = WA_INACTIVE then 
    Release; 
end; 

{ TPopupMenu } 

constructor TPopupMenu.Create(AOwner: TComponent); 
begin 
    inherited; 
    FPopupMode := pmStandard; 
    FPopupCount := 5; 
end; 

procedure TPopupMenu.Popup(X, Y: Integer); 
begin 
    case FPopupMode of 
    pmCustom: 
    with TPopupForm.Create(nil, FPopupForm, Self, FPopupCount) do 
    begin 
     Top := Y; 
     Left := X; 
     Show; 
    end; 
    pmStandard: inherited; 
    end; 
end; 

end. 

Jak wykorzystać tę rozszerzoną kontrolę menu:

Po prostu dodaj PopupUnit do końca swojej klauzuli uses, a elementy menu podręcznego otrzymają nowe właściwości.

Jeśli chcesz korzystać z trybu z formularza niestandardowego zamiast realnego menu, użyj następujących przed popup menu:

// this will enable the custom mode 
PopupMenu1.PopupMode := pmCustom; 
// this will fake the currently focused form as active, it is mandatory to 
// assign the currently focused form to this property (at least now); so Self 
// used here is the representation of the currently focused form 
PopupMenu1.PopupForm := Self; 
// this will show 5 menu items and the rest will be accessible by scroll bars 
PopupMenu1.PopupCount := 5; 

Jeśli chcesz użyć klasycznego menu podręczne pozostawić ustawienia, gdyż były one od tryb standardowy jest domyślny lub po prostu ustawić tryb ten sposób, a średnia podręczne menu będą wyświetlane (reszta nowych właściwości jest ignorowana w tym przypadku):

PopupMenu1.PopupMode := pmStandard; 

Zastrzeżenie:

Kod wymaga przeglądu (przynajmniej w ogóle brakuje implementacji skrótów menu) i niektóre części powinny zostać poprawione.

+0

To jest świetne, ale niestety nie mogę go użyć, ponieważ nie pokazuje podmenu. Nie sądzę, żebyś mógł dodać do tego wsparcie, prawda? – matthewk

Powiązane problemy