dfsstatusbar.pas

透明按钮 透明按钮 透明按钮

begin
  SetRectEmpty(Result);
  if HandleAllocated then
    if Perform(SB_GETRECT, Index, LPARAM(@Result)) = 0 then
      SetRectEmpty(Result); // SB_GETRECT failed, probably not visible
end;

procedure TDFSStatusBar.SetPanels(const Value: TDFSStatusPanels);
begin
  FPanels.Assign(Value);
// what about linked panels????
end;

destructor TDFSStatusBar.Destroy;
begin
  FPanels.Free;
  SelectObject(FExtentCanvas, FExtentFontOld);
  if FExtentFont <> 0 then
  begin
    DeleteObject(FExtentFont);
    FExtentFont := 0;
  end;
  if FExtentCanvas <> 0 then
  begin
    DeleteDC(FExtentCanvas);
    FExtentCanvas := 0;
  end;

  Assert(FMainWinHookClients.Count = 0, 'Unbalanced MainWinHook registrations');

  inherited Destroy;
  FMainWinHookClients.Free;
end;


procedure TDFSStatusBar.DrawPanel(Panel: TStatusPanel; const Rect: TRect);
var
  DFSPanel: TDFSStatusPanel;
  OldFont: HFONT;
begin
  // Panel is the REAL TStatusPanel, we need to find our special one.
  DFSPanel := FindLinkedPanel(Panel);
  Assert(DFSPanel <> NIL, 'Panel links corrupted');

  // Stupid VCL status bar doesn't always have the right font in Canvas.
  OldFont := SelectObject(Canvas.Handle, FExtentFont);
  try
    if Addr(OnDrawPanel) <> NIL then
      inherited DrawPanel(TStatusPanel(DFSPanel), Rect);
    DFSPanel.DrawPanel(Rect);
  finally
    SelectObject(Canvas.Handle, OldFont);
  end;
end;

function TDFSStatusBar.FindLinkedPanel(Panel: TStatusPanel): TDFSStatusPanel;
var
  x: integer;
begin
  Result := NIL;
  for x := 0 to Panels.Count-1 do
    if Panels[x].LinkedPanel = Panel then
    begin
      Result := Panels[x];
      break;
    end;
end;

function TDFSStatusBar.AppWinHook(var Message: TMessage): boolean;
begin
  if Message.Msg = WM_ACTIVATEAPP then
  begin
    if UseMonitorDLL then
    begin
{      if Message.wParam = 1 then
        PostMessage(Handle, WM_REFRESHLOCKINDICATORS, 0, 0);}
    end else begin
      // We're being deactivated, someone may change an indicator and that will
      // screw up the GetKeyState API call.
      if Message.wParam = 0 then
        MayNeedRefresh := TRUE;
      // Won't work in some situations if we call it directly.
      PostMessage(Handle, WM_REFRESHLOCKINDICATORS, 0, 0);
    end;
  end;
  Result := FALSE;
end;

procedure TDFSStatusBar.WMRefreshLockIndicators(var Msg: TMessage);
var
  x: integer;
begin
  Panels.BeginUpdate;
  try
    for x := 0 to Panels.Count-1 do
      if Panels[x].PanelType in [sptCapsLock, sptNumLock, sptScrollLock] then
        InvalidatePanel(Panels[x].Index);
  finally
    Panels.EndUpdate;
  end;
end;

procedure TDFSStatusBar.CMFontChanged(var Msg: TMessage);
var
  x: integer;
begin
  inherited;

  UpdateExtentFont;

  if Panels = NIL then exit;

  Panels.BeginUpdate;
  try
    for x := 0 to Panels.Count-1 do
      if Panels[x].AutoFit then
        Panels[x].UpdateAutoFitWidth;
  finally
    Panels.EndUpdate;
  end;
end;


procedure TDFSStatusBar.SetOnDrawPanel(const Value: TDFSDrawPanelEvent);
begin
  inherited OnDrawPanel := TDrawPanelEvent(Value);
end;

function TDFSStatusBar.GetOnDrawPanel: TDFSDrawPanelEvent;
begin
  TDrawPanelEvent(Result) := inherited OnDrawPanel;
end;

function TDFSStatusBar.GetVersion: TDFSVersion;
begin
  Result := DFS_COMPONENT_VERSION;
end;

procedure TDFSStatusBar.SetVersion(const Val: TDFSVersion);
begin
  { empty write method, just needed to get it to show up in Object Inspector }
end;


procedure TDFSStatusBar.CMEnabledChanged(var Msg: TMessage);
var
  x: integer;
begin
  inherited;
  Invalidate;
  for x := 0 to Panels.Count-1 do
    Panels[x].EnabledChanged;
end;

procedure TDFSStatusBar.CMHintShow(var Msg: TMessage);
  function FindClosestBefore(x: integer): TDFSStatusPanel;
  var
    y: integer;
  begin
    Result := NIL;
    for y := 0 to Panels.Count-1 do
    begin
      if GetPanelRect(y).Left < x then
        Result := Panels[y]
      else
        break;
    end;
(*  If I do it this way, it screws up.  Optimizaer bug, maybe?
    for y := Panels.Count-1 downto 0 do
    begin
      if GetPanelRect(y).Left < x then
      begin
        Result := Panels[y];
        break;
      end;
    end;*)
  end;

  function FindClosestAfter(x: integer): TDFSStatusPanel;
  var
    y: integer;
  begin
    Result := NIL;
    for y := 0 to Panels.Count-1 do
    begin
      if GetPanelRect(y).Right > x then
      begin
        Result := Panels[y];
        break;
      end;
    end;
  end;
var
  x: integer;
  Panel: TDFSStatusPanel;
  R: TRect;
begin
  inherited;

  with TCMHintShow(Msg) do
  begin
    begin
      Panel := NIL;
      for x := 0 to Panels.Count-1 do
      begin
        if PtInRect(GetPanelRect(x), HintInfo.CursorPos) then
        begin
          Panel := Panels[x];
          break;
        end;
      end;

      if (Panel = NIL) or (Panel.Hint = '') then
      begin
        // Hit a border, or a panel without a hint.  What we have to do here is
        // tell the hint info how big of a rectangle the hint applies to.  So,
        // we must find the first panel before this point with a hint, and the
        // first panel after this point with a hint and set CursorRect equal to
        // the area between those two panels.  CursorRect already has the area
        // of the status bar, so if we don't find a panel, it's ok.

        // Find first valid panel before hint position and set CursorRect.Left
        Panel := FindClosestBefore(HintInfo.CursorPos.x);
        while (Panel <> NIL) do
        begin
          R := GetPanelRect(Panel.Index);
          if Panel.Hint <> '' then
          begin
            HintInfo.CursorRect.Left := R.Right;
            Panel := NIL;
          end else
            Panel := FindClosestBefore(R.Left);
        end;

        // Find first valid panel after hint position and set CursorRect.Right
        Panel := FindClosestAfter(HintInfo.CursorPos.x);
        while (Panel <> NIL) do
        begin
          R := GetPanelRect(Panel.Index);
          if Panel.Hint <> '' then
          begin
            HintInfo.CursorRect.Right := R.Left;
            Panel := NIL;
          end else
            Panel := FindClosestAfter(R.Right);
        end;
      end else begin
        // Give it the hint of the panel
        HintInfo.HintStr := Panel.Hint;
        // Tell the hint mechanism that it needs to check the hint when the
        // cursor leaves the panel rectangle.
        HintInfo.CursorRect := GetPanelRect(Panel.Index);
      end;
    end;
  end;
end;

procedure TDFSStatusBar.DeregisterMainWinHook(Client: TDFSStatusPanel);
begin
  FMainWinHookClients.Remove(Client);
  Assert(FMainWinHookClients.Count >= 0, 'Unbalanced MainWinHook registrations');
  if FMainWinHookClients.Count < 1 then
    Application.UnhookMainWindow(AppWinHook);
end;

procedure TDFSStatusBar.RegisterMainWinHook(Client: TDFSStatusPanel);
begin
  FMainWinHookClients.Add(Client);
  if FMainWinHookClients.Count = 1 then
    Application.HookMainWindow(AppWinHook);
end;



procedure TDFSStatusBar.Loaded;
var
  x: integer;
begin
  inherited Loaded;

  UpdateExtentFont;

  for x := 0 to Panels.Count-1 do
    if Panels[x].AutoFit then
      Panels[x].UpdateAutoFitWidth;
end;

procedure TDFSStatusBar.CreateWnd;
var
  x: integer;
begin
  inherited CreateWnd;

  if not (csLoading in ComponentState) then
  begin
    UpdateExtentFont;

    for x := 0 to Panels.Count-1 do
      if Panels[x].AutoFit then
        Panels[x].UpdateAutoFitWidth;
  end;

  if FDLLClientCount > 0 then
    FKeyHookMsg := DLLRegisterKeyboardHook(Handle);
end;

procedure TDFSStatusBar.WMDestroy(var Msg: TWMDestroy);
begin
  if FUseMonitorDLL and (FDLLClientCount > 0) then
    DLLDeregisterKeyboardHook(Handle);

  inherited;
end;


function TDFSStatusBar.TextExtent(const Text: string): TSize;
begin
  if not GetTextExtentPoint32(FExtentCanvas, PChar(Text), Length(Text),
     Result) then
  begin
    Result.cx := -1;
    Result.cy := -1;
  end;
end;

procedure TDFSStatusBar.UpdateExtentFont;
begin
  if FExtentFont <> 0 then
  begin
    SelectObject(FExtentCanvas, FExtentFontOld);
    DeleteObject(FExtentFont);
  end;

  // In D4, the font handle might be different than what TFont describes!
  FExtentFont := CopyHFont(Font.Handle);
  FExtentFontOld := SelectObject(FExtentCanvas, FExtentFont);
end;

procedure TDFSStatusBar.SetUseMonitorDLL(const Value: boolean);
begin
  if FUseMonitorDLL <> Value then
  begin
    FUseMonitorDLL := Value;
    UpdateKeyboardHooks;
    if FUseMonitorDLL and (not DFSKbDLL_Loaded) {and
       not (csDesigning in ComponentState)} then
    begin
      UseMonitorDLL := FALSE;
      if csDesigning in ComponentState then
        raise Exception.Create('Could not load ' + DFSKbDLLName);
    end;    
  end;
end;

procedure TDFSStatusBar.UpdateKeyboardHooks;
var
  x: integer;
begin
  for x := 0 to Panels.Count-1 do
    Panels[x].UpdateKeyboardHook;
end;


procedure TDFSStatusBar.DeregisterSystemHook;
begin
  dec(FDLLClientCount);
  if FDLLClientCount < 1 then
  begin
    if DFSKbDLL_Loaded and HandleAllocated then
      DLLDeregisterKeyboardHook(Handle);
    FDLLClientCount := 0;
    if DFSKbDLL_Loaded then
      UnloadDFSKbDLL;
  end;
end;

procedure TDFSStatusBar.RegisterSystemHook;
begin
  inc(FDLLClientCount);
  if (FDLLClientCount = 1) {and not (csDesigning in ComponentState)} then
  begin
    if not DFSKbDLL_Loaded then
      InitDFSKbDLL;
    if HandleAllocated and DFSKbDLL_Loaded then
      FKeyHookMsg := DLLRegisterKeyboardHook(Handle);
  end;
end;

procedure TDFSStatusBar.WndProc(var Msg: TMessage);
  function VKToPanelType(VKCode: byte): TDFSStatusPanelType;
  begin
    case VKCode of
      VK_NUMLOCK: Result := sptNumLock;
      VK_SCROLL:  Result := sptScrollLock;
    else
      Result := sptCapsLock;
    end;
  end;
var
  x: integer;
begin
  if Msg.Msg = FKeyHookMsg then
  begin
    for x := 0 to Panels.Count-1 do
      if VKToPanelType(Msg.wParam) = Panels[x].PanelType then
      begin
        Panels[x].FKeyOn := Odd(Msg.lParam);
        Panels[x].Invalidate;
      end;
  end else
    inherited WndProc(Msg);
end;

procedure TDFSStatusBar.Click;
var
  x: integer;
  CursorPos: TPoint;
begin
  GetCursorPos(CursorPos);
  CursorPos := ScreenToClient(CursorPos);
  for x := 0 to Panels.Count-1 do
  begin
    if PtInRect(GetPanelRect(x), CursorPos) then
    begin
      Panels[x].Click;
      break;
    end;
  end;

  inherited Click;
end;

initialization
  {$IFDEF DFS_DEBUG}
  DFSDebug.Log('DFSStatusBar: init begin', TRUE);
  {$ENDIF}
  MayNeedRefresh := FALSE;
  KeyboardHookHandle := 0;
  KeyHookClients := TList.Create;
  RegisteredTimers := 0;
  {$IFDEF DFS_DEBUG}
  DFSDebug.Log('DFSStatusBar: init end.', TRUE);
  {$ENDIF}

finalization

  {$IFDEF DFS_DEBUG}
  DFSDebug.Log('DFSStatusBar: finalization begin.', TRUE);
  {$ENDIF}
  // remove hook just in case it somehow got left installed
  if KeyboardHookHandle <> 0 then
  begin
    UnhookWindowsHookEx(KeyboardHookHandle);
    KeyboardHookHandle := 0;
    Assert(FALSE, 'TDFSStatusBar: Keyboard hook still installed');
  end;

  Assert(RegisteredTimers = 0, 'TDFSStatusBar: Unbalanced timer registrations');

  KeyHookClients.Free;
  KeyHookClients := NIL;

  if DFSKb.DFSKbDLL_Loaded then
    UnloadDFSKbDLL;

  {$IFDEF DFS_DEBUG}
  DFSDebug.Log('DFSStatusBar: finalization end.', TRUE);
  {$ENDIF}
end.