cmpmenudesigner.pas

學習資料網上下載

          if vertMenu then
            if idx > 0 then
              SelectedItem := parent.Items [idx - 1]
            else
              if not vertParent then
                SelectedItem := grandparent.Items [gidx];

        VK_DOWN :
          if vertMenu then
          begin
            if idx < parent.Count - 1 then
              SelectedItem := parent.Items [idx + 1]
          end
          else
            if SelectedItem.Count > 0 then
              SelectedItem := SelectedItem.Items [0];
      end
  end;
  inherited;
end;

procedure TBaseMenuDesigner.MouseDown(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  i : TMenuItem;
begin
  SetFocus;
  i := ItemAt (X, Y);
  if i <> Nil then
    SelectedItem := i;
  inherited;
end;

procedure TBaseMenuDesigner.PaintItems(x, y: Integer; items: TMenuItem);
var
  w, m, h : Integer;
  lh, i : Integer;
  item : TMenuItem;
  r : TRect;
begin
  CalcItemsSize (items, w, m, h);

  r.Left := x;
  r.Right := x + w + m;
  r.top := y;
  r.bottom := y + h;

  Canvas.Brush.Color := clBtnFace;
  Canvas.FillRect (r);

  DrawEdge (Canvas.Handle, r, EDGE_RAISED, BF_RECT);

  lh := GetSystemMetrics (SM_CYMENU);

  Inc (y, menuTopMargin);

  for i := 0 to items.Count - 1 do
  begin
    item := items.Items [i];
    DrawItem (item, x, y, w, m, menuLeftMargin, menuRightMargin, lh, True);

    if (item.Count > 0) and TDesignerMenuItem (item).Selected then
      PaintItems (x + w + m, y - menuTopMargin, item);
    y := y + lh
  end
end;

procedure TBaseMenuDesigner.RestoreTags;

  procedure RestoreItemTags (item : TMenuItem);
  var
    i : Integer;
  begin
    TDesignerMenuItem (item).Selected := False;
    for i := 0 to item.Count - 1 do
      RestoreItemTags (item.Items [i])
  end;

begin
  RestoreItemTags (Items)
end;

procedure TBaseMenuDesigner.SetItems(const Value: TMenuItem; keepPosition : boolean);
var
  selItem : TMenuItem;

  procedure AssignItem (src, dest : TMenuItem);
  var
    i : Integer;
    newItem : TMenuItem;
  begin
    dest.Caption := src.Caption;
    dest.Tag := src.Tag;
    dest.ShortCut := src.ShortCut;
    dest.Enabled := src.Enabled;
    dest.Checked := src.Checked;

    for i := 0 to src.Count - 1 do
    begin
      newItem := TDesignerMenuItem.Create (self);
      dest.Add (newItem);
      AssignItem (src.Items [i], newItem)
    end
  end;

begin
  Items.Clear;
  fSelectedItem := Nil;
  AssignItem (value, items);

  if KeepPosition then
  begin
    selItem := GetSnapshotItem;
    if Assigned (selItem) then
      SelectedItem := selItem
    else
      SelectedITem := Items [0]
  end
  else
    SelectedItem := Items [0];
  ReAlign;
  fDirty := False;
  Invalidate
end;

procedure TBaseMenuDesigner.SetSelectedItem(const Value: TMenuItem);
var
  p : TMenuItem;

  procedure ClearSelection (items : TMenuItem);
  var
    i : Integer;
    item : TMenuItem;
  begin
    for i := 0 to items.Count - 1 do
    begin
      item := items.Items [i];
      if TDesignerMenuItem (Item).Selected then
      begin
        TDesignerMenuItem (item).Selected := False;
        ClearSelection (item)
      end
    end
  end;

begin
  if Assigned (value) and not (value is TDesignerMenuItem) then
    raise Exception.Create ('Can''t select item');

  if fSelectedItem <> value then
  begin
    ClearSelection (fItems);
    p := value;
    while Assigned (p) do
    begin
      TDesignerMenuItem (p).Selected := True;
      p := p.Parent
    end;
    DoChangeSelectedItem (Value);
    Invalidate
  end
  else
  begin
    DoChangeSelectedItem (Value);
    Invalidate
  end
end;

procedure TBaseMenuDesigner.TakeSnapshot;
  procedure Snapshot (item : TMenuItem);
  begin
    if Assigned (item) then
    begin
      Snapshot (item.Parent);
      fPositionSnapshot.Add (pointer (item.MenuIndex))
    end
  end;
begin
  fPositionSnapshot.Clear;
  Snapshot (fSelectedItem);
end;

procedure TBaseMenuDesigner.WmGetDLGCode(var msg: TwmGetDlgCode);
begin
  msg.Result := DLGC_WANTARROWS
end;

{ TMenuDesigner }

procedure TMenuDesigner.CalcSize(var w, h: Integer);
var
  i : Integer;
  w1, h1, y : Integer;

  procedure CalcSubmenuExtent (item : TMenuItem; x, y : Integer; var w, h : Integer);
  var
    i, wST, wShortCut, w1, h1 : Integer;
  begin
    if item.Count > 0 then
    begin
      CalcItemsSize (item, wST, wShortCut, h1);
      w := x + wST + wShortCut + 2 * GetSystemMetrics (SM_CXEDGE);
      h := y + h1 + 2 * GetSystemMetrics (SM_CYEDGE);

      for i := 0 to item.Count - 1 do
      begin
        CalcSubmenuExtent (item.Items [i], x + w, y + GetSystemMetrics (SM_CYMENU) * i, w1, h1);

        if h1 > h then h := h1;
        if w1 > w then w := w1
      end
    end
    else
    begin
      w := x;
      h := y
    end
  end;

begin
  h := 3 + GetSystemMetrics (SM_CYMENU);
  w := menuLeftMargin + menuRightMargin;
  y := h;

  for i := 0 to items.Count - 1 do
  begin
    CalcSubmenuExtent (items.items [i], 0, y, w1, h1);

    if w1 > w then w := w1;
    if h1 > h then h := h1
  end
end;

constructor TMenuDesigner.Create(AOwner: TComponent);
begin
  inherited;
  Align := alTop;
  Height := 182;
end;

function TMenuDesigner.ItemAt(X, Y: Integer): TMenuItem;
var
  i, tm : Integer;
  st : string;
  item : TMenuItem;
  r : TRect;
  xp : Integer;
begin
  tm := 3;
  xp := 0;
  result := Nil;
  for i := 0 to Items.Count - 1 do
  begin
    item := Items.Items [i];
    st := item.Caption;
    r.Left := xp;
    r.Right := xp + DrawTextWidth (mainMenuLeftMargin, mainMenuRightMargin, st);
    r.Top := tm;
    r.Bottom := tm + GetSystemMetrics (SM_CYMENU);

    if PtInRect (r, Point (X, Y)) then
    begin
      result := Item;
      break
    end;

    if (item.Count > 0) and TDesignerMenuItem (item).Selected then
      result := ItemAtOffset (item, xp + 1, r.Bottom, X, Y);
    xp := r.right;
  end
end;

procedure TMenuDesigner.Paint;
var
  x, x1, i, tm : Integer;
  item : TMenuItem;
  r : TRect;
begin
  inherited;

  tm := 3;
  x := 0;

  r := Rect (0, 0, ClientWidth, GetSystemMetrics (SM_CYMENU) + 7);
  DrawEdge (Canvas.Handle, r, EDGE_ETCHED, BF_BOTTOM);

  for i := 0 to Items.Count - 1 do
  begin
    item := Items.Items [i];

    x1 := DrawItem (item, x, tm, -1, -1, mainMenuLeftMargin, mainMenuRightMargin, GetSystemMetrics (SM_CYMENU), False);

    if (item.Count > 0) and TDesignerMenuItem (item).Selected then
      PaintItems (x + 1, r.Bottom, item);

    x := x1
  end
end;

{ TPopupMenuDesigner }

procedure TPopupMenuDesigner.CalcSize(var w, h: Integer);
begin

end;

constructor TPopupMenuDesigner.Create(AOwner: TComponent);
begin
  inherited;
  Width := 185;
  Height := 41;
end;

function TPopupMenuDesigner.ItemAt(X, Y: Integer): TMenuItem;
begin
  result := Nil;
end;

procedure TPopupMenuDesigner.Paint;
begin
  inherited;
end;

{ TDesignerMenuItem }

function TDesignerMenuItem.GetID: Integer;
begin
  result := Tag;
  if result < -1 then
     result := (-result) - 3
end;

function TDesignerMenuItem.GetSelected: boolean;
begin
  result := Tag < -1
end;

procedure TDesignerMenuItem.MenuChanged(Rebuild: Boolean);
begin
  inherited;
  TBaseMenuDesigner (Owner).fDirty := True;
  TBaseMenuDesigner (Owner).Invalidate
end;

procedure TDesignerMenuItem.SetID(const Value: Integer);
var
  p : TMenuItem;

  procedure CheckDuplicateIds (p : TMenuItem);
  var
    i : Integer;
  begin
    if (p is TDesignerMenuItem) and (p <> Self) and (TDesignerMenuItem (p).ID = Value) and (TDesignerMenuItem (p).ID <> -1) and (TDesignerMenuItem (p).ID <> 0) then
      raise Exception.Create ('Duplicate menu ID');

    for i := 0 to p.Count - 1 do
      CheckDuplicateIds (p.Items [i])
  end;
begin
  p := Self;
  while Assigned (p.Parent) do
    p := p.Parent;

  CheckDuplicateIDs (p);

  if Selected then
    Tag := -(value + 3)
  else
    Tag := value;

  MenuChanged (True)
end;

procedure TDesignerMenuItem.SetSelected(const Value: boolean);
begin
  if Value <> Selected then
    if Value then
      Tag := -(Tag + 3)
    else
      Tag := ID
end;

end.