dfsstatusbar.pas

动态提示控件

  if Txt <> Text then
  begin
    Text := Txt;
    //    Invalidate(TRUE);
    Redraw(Statusbar.Canvas, StatusBar.GetPanelRect(Index));
  end;
end;

procedure TdfsStatusPanel.GlyphChanged(Sender: TObject);
begin
  if PanelType = sptGlyph then
  begin
    Invalidate;
    UpdateAutoFitWidth;
  end;
end;


procedure TdfsStatusPanel.DrawPanel(Rect: TRect);
begin
  if (csDesigning in StatusBar.ComponentState) or (Addr(OnDrawPanel) = NIL) or
     (PanelType <> sptOwnerDraw) then
    Redraw(StatusBar.Canvas, StatusBar.GetPanelRect(Index))
  else if assigned(FOnDrawPanel) then
    FOnDrawPanel(StatusBar, Self, Rect);
end;


function TdfsStatusPanel.GetEnabled: boolean;
begin
  if csWriting in StatusBar.ComponentState then
    Result := FEnabled
  else
    Result := FEnabled and StatusBar.Enabled;
end;

procedure TdfsStatusPanel.EnabledChanged;
begin
  // Enabled property (self or parent) changed, update register/deregister calls
  if Enabled then
  begin
    case FPanelType of
      sptCapsLock, sptNumLock, sptScrollLock:
        begin
          if StatusBar.UseMonitorDLL then
          begin
            StatusBar.RegisterSystemHook;
            FKeyOn := Odd(GetKeyState(KEY_CODE[FPanelType]));
          end else begin
            RegisterTaskKeyboardHook(Self);
            StatusBar.RegisterMainWinHook(Self);
          end;
        end;
      sptDate, sptTime, sptDateTime, sptTimeDate:
        TdfsStatusPanels(Collection).RegisterTimer(Self);
      sptGauge:
        if GaugeAttrs.Style in IndeterminateGuages then
          TdfsStatusPanels(Collection).RegisterTimer(Self);
    end;
  end else begin
    case FPanelType of
      sptCapsLock, sptNumLock, sptScrollLock:
        begin
          if StatusBar.UseMonitorDLL then
            StatusBar.DeregisterSystemHook
          else begin
            DeregisterTaskKeyboardHook(Self);
            StatusBar.DeregisterMainWinHook(Self);
          end;
        end;
      sptDate, sptTime, sptDateTime, sptTimeDate:
        TdfsStatusPanels(Collection).DeregisterTimer(Self);
      sptGauge:
        if GaugeAttrs.Style in IndeterminateGuages then
          TdfsStatusPanels(Collection).DeregisterTimer(Self);
    end;
  end;

  Invalidate;
  if not Enabled then
  begin
    FGaugeLastPos := 0;
    FGaugeDirection := GaugeAttrs.Speed;
  end;
end;


function TdfsStatusPanel.GetHint: string;
begin
  if (not (csDesigning in StatusBar.ComponentState)) and
     (PanelType in [sptEllipsisText, sptEllipsisPath]) and (FHint = '...') then
    Result := Text
  else
    Result := FHint;
  DoHintText(Result);
end;

procedure TdfsStatusPanel.DoHintText(var HintText: string);
begin
  if assigned(FOnHintText) then
    FOnHintText(StatusBar, Self, HintText);
end;

procedure TdfsStatusPanel.SetGaugeAttrs(const Value: TdfsGaugeAttrs);
begin
  FGaugeAttrs := Value;
end;

function TdfsStatusPanel.GetDisplayName: string;
begin
  case PanelType of
    sptNormal, sptEllipsisText, sptEllipsisPath:
      Result := Text;
  else
    Result := GetEnumName(TypeInfo(TdfsStatusPanelType), ord(PanelType));
  end;

  if Result = '' then
    Result := inherited GetDisplayName;
end;

procedure TdfsStatusPanel.SetIndex(Value: integer);
var
  CurIndex: Integer;
begin
  CurIndex := Index;
  if (CurIndex >= 0) and (CurIndex <> Value) then
  begin
    TdfsStatusPanels(Collection).FLinkedPanels[CurIndex].Index := Value;
    inherited SetIndex(Value);
  end;
end;

function TdfsStatusPanel.GetLinkedPanel: TStatusPanel;
begin
  Result := TdfsStatusPanels(Collection).FLinkedPanels[Index];
end;


procedure TdfsStatusPanel.UpdateKeyboardHook;
begin
  if PanelType in [sptCapsLock, sptNumLock, sptScrollLock] then
  begin
    if StatusBar.UseMonitorDLL and Enabled then
    begin
      DeregisterTaskKeyboardHook(Self);
      StatusBar.DeregisterMainWinHook(Self);
      StatusBar.RegisterSystemHook;
      FKeyOn := Odd(GetKeyState(KEY_CODE[FPanelType]));
    end else if (not StatusBar.UseMonitorDLL) and Enabled then
    begin
      StatusBar.DeregisterSystemHook;
      RegisterTaskKeyboardHook(Self);
      StatusBar.RegisterMainWinHook(Self);
    end;
  end;
end;

procedure TdfsStatusPanel.Click;
begin
  if assigned(FOnClick) then
    FOnClick(Self);
end;

function TdfsStatusPanel.GetGaugeBitmap: TBitmap;
begin
  if FGaugeBitmap = NIL then
    FGaugeBitmap := InitGaugeBitmap;
  Result := FGaugeBitmap;
end;

procedure TdfsStatusPanel.SetBorderWidth(const Value: TBorderWidth);
begin
  if FBorderWidth <> Value then
  begin
    FBorderWidth := Value;
    UpdateAutoFitWidth;
    Invalidate;
  end;
end;

function TdfsStatusPanel.IsTextStored: Boolean;
begin
  Result := not (PanelType in [sptDate, sptTime, sptDateTime, sptTimeDate]);
end;

{ TdfsStatusPanels }

function TdfsStatusPanels.Add: TdfsStatusPanel;
begin
  Result := TdfsStatusPanel(inherited Add);
end;

constructor TdfsStatusPanels.Create(StatusBar: TdfsStatusBar;
   LinkedPanels: TStatusPanels);
begin
  FStatusBar := StatusBar;
  FLinkedPanels := LinkedPanels;
  FTimer := NIL;
  FTimerClients := TList.Create;

  inherited Create(TdfsStatusPanel);
end;

procedure TdfsStatusPanels.DeregisterTimer(Client: TdfsStatusPanel);
var
  x: integer;
  NewTimerRes: integer;
begin
  if FTimerClients.Remove(Client) <> -1 then
    dec(RegisteredTimers);
  if FTimerClients.Count < 1 then
  begin
    FTimer.Free;
    FTimer := NIL;
  end else begin
    NewTimerRes := 60000; // Least impact we can manage easily
    for x := 0 to FTimerClients.Count-1 do
      case TdfsStatusPanel(FTimerClients[x]).PanelType of
        sptTime, sptDateTime, sptTimeDate:
          NewTimerRes := 1000;
        sptGauge:
          if TdfsStatusPanel(FTimerClients[x]).GaugeAttrs.Style in
             IndeterminateGuages then begin
            NewTimerRes := INDETERMINATE_GAUGE_UPDATE_INTERVAL;
            break;
          end;
      end;

    FTimer.Interval := NewTimerRes;
  end;
end;

destructor TdfsStatusPanels.Destroy;
begin
  // Call inherited first because it causes children to be destroyed, and that
  // might cause FTimerClients to be needed.
  inherited Destroy;

  FTimer.Free;
  FTimer := NIL;
  FTimerClients.Free;
  FTimerClients := NIL; // Yes, there is a reason for this!
end;

function TdfsStatusPanels.GetItem(Index: Integer): TdfsStatusPanel;
begin
  Result := TdfsStatusPanel(inherited GetItem(Index));
end;

function TdfsStatusPanels.GetOwner: TPersistent;
begin
  Result := FStatusBar;
end;

procedure TdfsStatusPanels.RegisterTimer(Client: TdfsStatusPanel);
var
  FirstClient: boolean;
begin
  if FTimer = NIL then
  begin
    FTimer := TTimer.Create(FStatusBar);
    FLastDate := Date;
    FTimer.OnTimer := TimerEvent;
  end;
  if FTimerClients.IndexOf(Client) >= 0 then
    exit;  // We're already in the list!
    
  FTimerClients.Add(Client);
  inc(RegisteredTimers);
  FirstClient := FTimerClients.Count = 1;
  case Client.PanelType of
    sptDate:
      if FirstClient then
        FTimer.Interval := 60000; // Least impact we can manage easily
    sptTime, sptDateTime, sptTimeDate:
      if FirstClient or (FTimer.Interval > 1000) then
        FTimer.Interval := 1000;
    sptGauge:
      if Client.GaugeAttrs.Style in IndeterminateGuages then
        FTimer.Interval := INDETERMINATE_GAUGE_UPDATE_INTERVAL;
  end;
  FTimer.Enabled := TRUE;
end;

procedure TdfsStatusPanels.SetItem(Index: Integer; Value: TdfsStatusPanel);
begin
  // I have no idea if this will work or not....
  inherited SetItem(Index, Value);
  FLinkedPanels[Index] := Value.LinkedPanel;
end;

procedure TdfsStatusPanels.TimerEvent(Sender: TObject);
var
  x: integer;
  DateUpdate: boolean;
  Panel: TdfsStatusPanel;
begin
  if FLastDate <> Date then
  begin
    DateUpdate := TRUE;
    FLastDate := Date;
  end else
    DateUpdate := FALSE;

  for x := 0 to FTimerClients.Count-1 do
  begin
    Panel := TdfsStatusPanel(FTimerClients[x]); // shorthand
    if (Panel.PanelType in [sptTime, sptDateTime, sptTimeDate]) or
       (DateUpdate and (Panel.PanelType = sptDate)) or
       ((Panel.PanelType = sptGauge) and
       (Panel.GaugeAttrs.Style in IndeterminateGuages)) then
      TdfsStatusPanel(FTimerClients[x]).TimerNotification;
  end;
end;

procedure TdfsStatusPanels.Update(Item: TCollectionItem);
begin
  if Item is TdfsStatusPanel then
    TdfsStatusPanel(Item).Invalidate
  else
    FStatusBar.Invalidate;
end;

{ TdfsStatusBar }

constructor TdfsStatusBar.Create(AOwner: TComponent);
begin
  FExtentCanvas := CreateCompatibleDC(0);
  FExtentFont := 0;
  FExtentFontOld := 0;
  FUseMonitorDLL := FALSE;
  FDLLClientCount := 0;
  FMainWinHookClients := TList.Create;

  inherited Create(AOwner);

  // Allow it to accept controls dropped onto it.
  ControlStyle:= ControlStyle + [csAcceptsControls];

  FPanels := TdfsStatusPanels.Create(Self, inherited Panels);
end;

procedure TdfsStatusBar.InvalidatePanel(Index: integer);
var
  PanelRect: TRect;
begin
  if (Index >= 0) and (Index < Panels.Count) then
  begin
    PanelRect := GetPanelRect(Index);
    if not IsRectEmpty(PanelRect) then
      Panels[Index].Redraw(Canvas, PanelRect)
  end else begin
    {$IFDEF DFS_COMPILER_6_UP}
    TList.Error(@SListIndexError, Index);
    {$ELSE}
    {$IFDEF DFS_COMPILER_3_UP}
    raise EListError.Create(SListIndexError);
    {$ELSE}
    raise EListError.CreateRes(SListIndexError);
    {$ENDIF}
    {$ENDIF}
  end;
end;

function TdfsStatusBar.GetPanelRect(Index: integer): TRect;
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.