tb97ctls.pas

企业智能(ERP)管理系统

        WM_MENUSELECT:
          with TWMMenuSelect(Message) do begin
            FindKind := fkCommand;
            if MenuFlag and MF_POPUP <> 0 then
              FindKind := fkHandle;
            for I := 0 to Count-1 do begin
              MenuItem := TPopupMenu(Items[I]).FindItem(IDItem, FindKind);
              if MenuItem <> nil then begin
                Application.Hint := MenuItem.Hint;
                Exit;
              end;
            end;
            Application.Hint := '';
          end;
        WM_HELP:
          with TWMHelp(Message).HelpInfo^ do begin
            for I := 0 to Count-1 do
              if TPopupMenu(Items[I]).Handle = hItemHandle then begin
                ContextID := TPopupMenu(Items[I]).GetHelpContext(iCtrlID, True);
                if ContextID = 0 then
                  ContextID := TPopupMenu(Items[I]).GetHelpContext(hItemHandle, False);
                if Screen.ActiveForm = nil then Exit;
                if (biHelp in Screen.ActiveForm.BorderIcons) then
                  Application.HelpCommand (HELP_CONTEXTPOPUP, ContextID)
                else
                  Application.HelpContext (ContextID);
                Exit;
              end;
          end;
      end;
    with Message do
      Result := DefWindowProc(Window, Msg, wParam, lParam);
  except
    Application.HandleException (Self);
  end;
end;

procedure TDropdownList.AddMenu (Menu: TPopupMenu);
begin
  if List.IndexOf(Menu) = -1 then begin
    if List.Count = 0 then
      Window := AllocateHWnd(WndProc);
    Menu.FreeNotification (Self);
    List.Add (Menu);
  end;
end;

procedure TDropdownList.Notification (AComponent: TComponent; Operation: TOperation);
begin
  inherited;
  if Operation = opRemove then begin
    List.Remove (AComponent);
    if List.Count = 0 then
      DeallocateHWnd (Window);
  end;
end;

{$ENDIF}


{ TToolbarButton97 }

procedure ButtonHookProc (Code: THookProcCode; Wnd: HWND; WParam: WPARAM; LParam: LPARAM);
var
  P: TPoint;
begin
  case Code of
    hpSendActivateApp:
      if (WParam = 0) and Assigned(ButtonMouseInControl) and
         not ButtonMouseInControl.FShowBorderWhenInactive then
        ButtonMouseInControl.MouseLeft;
    hpPostMouseMove: begin
        if Assigned(ButtonMouseInControl) then begin
          GetCursorPos (P);
          if FindDragTarget(P, True) <> ButtonMouseInControl then
            ButtonMouseInControl.MouseLeft;
        end;
      end;
  end;
end;

constructor TToolbarButton97.Create (AOwner: TComponent);
begin
  inherited;

  if ButtonMouseTimer = nil then begin
    ButtonMouseTimer := TTimer.Create(nil);
    ButtonMouseTimer.Enabled := False;
    ButtonMouseTimer.Interval := 125;  { 8 times a second }
  end;

  InstallHookProc (ButtonHookProc, [hpSendActivateApp, hpPostMouseMove],
    csDesigning in ComponentState);

  SetBounds (Left, Top, 23, 22);
  ControlStyle := [csCaptureMouse, csDoubleClicks, csOpaque];
  Color := clBtnFace;
  FGlyph := TButtonGlyph.Create;
  TButtonGlyph(FGlyph).OnChange := GlyphChanged;
  ParentFont := True;
  FAlignment := taCenter;
  FFlat := True;
  FOpaque := True;
  FSpacing := 4;
  FMargin := -1;
  FLayout := blGlyphLeft;
  FDropdownArrow := True;
  FRepeatDelay := 400;
  FRepeatInterval := 100;
  Inc (ButtonCount);
end;

destructor TToolbarButton97.Destroy;
begin
  RemoveButtonMouseTimer;
  TButtonGlyph(FGlyph).Free;
  { The Notification method, which is sometimes called while the component is
    being destroyed, reads FGlyph and expects it to be valid, so it must be
    reset to nil }
  FGlyph := nil;
  UninstallHookProc (ButtonHookProc);
  Dec (ButtonCount);
  if ButtonCount = 0 then begin
    Pattern.Free;
    Pattern := nil;
    ButtonMouseTimer.Free;
    ButtonMouseTimer := nil;
  end;
  inherited;
end;

procedure TToolbarButton97.Paint;
const
  EdgeStyles: array[Boolean, Boolean] of UINT = (
    (EDGE_RAISED, EDGE_SUNKEN),
    (BDR_RAISEDINNER, BDR_SUNKENOUTER));
  FlagStyles: array[Boolean] of UINT = (BF_RECT or BF_SOFT or BF_MIDDLE, BF_RECT);
var
  Bmp: TBitmap;
  DrawCanvas: TCanvas;
  PaintRect, R: TRect;
  Offset: TPoint;
  StateDownOrExclusive: Boolean;
begin
  if FOpaque or not FFlat then
    Bmp := TBitmap.Create
  else
    Bmp := nil;
  try
    if FOpaque or not FFlat then begin
      Bmp.Width := Width;
      Bmp.Height := Height;
      DrawCanvas := Bmp.Canvas;
      with DrawCanvas do begin
        Brush.Color := Color;
        FillRect (ClientRect);
      end;
    end
    else
      DrawCanvas := Canvas;
    DrawCanvas.Font := Self.Font;
    PaintRect := Rect(0, 0, Width, Height);
    StateDownOrExclusive := FState in [bsDown, bsExclusive];

    if ((not FNoBorder) and
        (not FFlat or StateDownOrExclusive or
        (FMouseInControl and (FState <> bsDisabled)))) or
       (csDesigning in ComponentState) then begin
      if DropdownCombo and FUsesDropdown then begin
        R := PaintRect;
        R.Left := R.Right - DropdownComboWidth;
        Dec (R.Right, 2);
        DrawEdge (DrawCanvas.Handle, R,
          EdgeStyles[FFlat, StateDownOrExclusive and FMenuIsDown],
          FlagStyles[FFlat]);
        Dec (PaintRect.Right, DropdownComboWidth);
      end;
      DrawEdge (DrawCanvas.Handle, PaintRect,
        EdgeStyles[FFlat, StateDownOrExclusive and (not(DropdownCombo and FUsesDropdown) or not FMenuIsDown)],
        FlagStyles[FFlat]);
    end
    else
      if DropdownCombo and FUsesDropdown then
        Dec (PaintRect.Right, DropdownComboWidth);
    if not FNoBorder then begin
      if FFlat then
        InflateRect (PaintRect, -1, -1)
      else
        InflateRect (PaintRect, -2, -2);
    end;

    if StateDownOrExclusive and (not(DropdownCombo and FUsesDropdown) or not FMenuIsDown) then begin
      if (FState = bsExclusive) and (not FFlat or not FMouseInControl) then begin
        if Pattern = nil then CreateBrushPattern;
        DrawCanvas.Brush.Bitmap := Pattern;
        DrawCanvas.FillRect(PaintRect);
      end;
      Offset.X := 1;
      Offset.Y := 1;
    end
    else begin
      Offset.X := 0;
      Offset.Y := 0;
    end;

    TButtonGlyph(FGlyph).Draw (DrawCanvas, PaintRect, Offset,
      FDisplayMode <> dmTextOnly, FDisplayMode <> dmGlyphOnly,
      Caption, FWordWrap, FAlignment, FLayout, FMargin, FSpacing,
      FDropdownArrow and not FDropdownCombo and FUsesDropdown, FState);
    if FDropdownCombo and FUsesDropdown then
      TButtonGlyph(FGlyph).DrawButtonDropArrow (DrawCanvas, Width-DropdownComboWidth-2,
        Height div 2 - 1, FState);

    if FOpaque or not FFlat then
      Canvas.Draw (0, 0, Bmp);
  finally
    if FOpaque or not FFlat then
      Bmp.Free;
  end;
end;

procedure TToolbarButton97.RemoveButtonMouseTimer;
begin
  if ButtonMouseInControl = Self then begin
    ButtonMouseTimer.Enabled := False;
    ButtonMouseInControl := nil;
  end;
end;

procedure TToolbarButton97.UpdateTracking;
var
  P: TPoint;
begin
  if Enabled then begin
    GetCursorPos (P);
    { Use FindDragTarget instead of PtInRect since we want to check based on
      the Z order }
    FMouseInControl := not (FindDragTarget(P, True) = Self);
    if FMouseInControl then
      MouseLeft
    else
      MouseEntered;
  end;
end;

procedure TToolbarButton97.Loaded;
var
  State: TButtonState97;
begin
  inherited;
  if Enabled then
    State := bsUp
  else
    State := bsDisabled;
  TButtonGlyph(FGlyph).CreateButtonGlyph (State);
end;

procedure TToolbarButton97.Notification (AComponent: TComponent; Operation: TOperation);
begin
  inherited;
  if Operation = opRemove then begin
    if AComponent = DropdownMenu then DropdownMenu := nil;
    if Assigned(FGlyph) and (AComponent = Images) then Images := nil;
  end;
end;

function TToolbarButton97.PointInButton (X, Y: Integer): Boolean;
begin
  Result := (X >= 0) and (X < ClientWidth-(DropdownComboWidth * Ord(FDropdownCombo and FUsesDropdown))) and
    (Y >= 0) and (Y < ClientHeight);
end;

procedure TToolbarButton97.MouseDown (Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  if not Enabled then begin
    inherited;
    Exit;
  end;
  if Button <> mbLeft then begin
    MouseEntered;
    inherited;
  end
  else begin
    { We know mouse has to be over the control if the mouse went down. }
    MouseEntered;
    FMenuIsDown := FUsesDropdown and (not FDropdownCombo or (X >= Width-DropdownComboWidth));
    try
      if not FDown then begin
        FState := bsDown;
        Redraw (True);
      end
      else
        if FAllowAllUp then
          Redraw (True);
      if not FMenuIsDown then
        FMouseIsDown := True;
      inherited;
      if FMenuIsDown then
        Click
      else
        if FRepeating then begin
          Click;
          if not Assigned(FRepeatTimer) then
            FRepeatTimer := TTimer.Create(Self);
          FRepeatTimer.Enabled := False;
          FRepeatTimer.Interval := FRepeatDelay;
          FRepeatTimer.OnTimer := RepeatTimerHandler;
          FRepeatTimer.Enabled := True;
        end;
    finally
      FMenuIsDown := False;
    end;
  end;
end;

procedure TToolbarButton97.MouseMove (Shift: TShiftState; X, Y: Integer);
var
  P: TPoint;
  NewState: TButtonState97;
  PtInButton: Boolean;
begin
  inherited;

  { Check if mouse just entered the control. It works better to check this
    in MouseMove rather than using CM_MOUSEENTER, since the VCL doesn't send
    a CM_MOUSEENTER in all cases
    Use FindDragTarget instead of PtInRect since we want to check based on
    the Z order }
  P := ClientToScreen(Point(X, Y));
  if (ButtonMouseInControl <> Self) and (FindDragTarget(P, True) = Self) then begin
    if Assigned(ButtonMouseInControl) then
      ButtonMouseInControl.MouseLeft;
    { Like Office 97, only draw the active borders when the application is active }
    if FShowBorderWhenInactive or ApplicationIsActive then begin
      ButtonMouseInControl := Self;
      ButtonMouseTimer.OnTimer := ButtonMouseTimerHandler;
      ButtonMouseTimer.Enabled := True;
      MouseEntered;
    end;
  end;

  if FMouseIsDown then begin
    PtInButton := PointInButton(X, Y);
    if PtInButton and Assigned(FRepeatTimer) then
      FRepeatTimer.Enabled := True;
    if FDown then
      NewState := bsExclusive
    else begin
      if PtInButton then
        NewState := bsDown
      else
        NewState := bsUp;
    end;
    if NewState <> FState then begin
      FState := NewState;
      Redraw (True);
    end;
  end;
end;

procedure TToolbarButton97.RepeatTimerHandler (Sender: TObject);
var
  P: TPoint;
begin
  FRepeatTimer.Interval := FRepeatInterval;
  GetCursorPos (P);
  P := ScreenToClient(P);
  if Repeating and FMouseIsDown and MouseCapture and PointInButton(P.X, P.Y) then
    Click
  else
    FRepeatTimer.Enabled := False;
end;

procedure TToolbarButton97.WMCancelMode (var Message: TWMCancelMode);
begin
  FRepeatTimer.Free;
  FRepeatTimer := nil;
  if FMouseIsDown then begin
    FMouseIsDown := False;
    MouseLeft;
  end;
  { Delphi's default processing of WM_CANCELMODE sends a "fake" WM_LBUTTONUP
    message to the control, so inherited must only be called af