dfsstatusbar.pas

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

          AutoFit := TRUE;
          if Enabled then
          begin
            if StatusBar.UseMonitorDLL then
            begin
              StatusBar.RegisterSystemHook;
              FKeyOn := Odd(GetKeyState(KEY_CODE[FPanelType]));
            end else begin
              RegisterTaskKeyboardHook(Self);
              StatusBar.RegisterMainWinHook(Self);
            end;
          end;
        end;
      sptDate, sptTime, sptDateTime:
        begin
          AutoFit := FALSE;
          if Enabled then
            TDFSStatusPanels(Collection).RegisterTimer(Self);
          UpdateDateTime;
        end;
      sptEllipsisText, sptEllipsisPath:
        begin
          AutoFit := FALSE;
          if Hint = '' then
            Hint := '...'; 
        end;
      sptGlyph:
        begin
          AutoFit := TRUE;
        end;
      sptGauge:
        begin
          AutoFit := FALSE;
          Alignment := taCenter;
          if GaugeAttrs.Style = gsIndeterminate then
          begin
            Enabled := FALSE; // Enabled is false, so don't need to register
            FGaugeLastPos := 0;
            FGaugeDirection := 1;
          end;
        end;
    else
      AutoFit := FALSE;
    end;
    
    Invalidate;
  end;
end;


procedure TDFSStatusPanel.SetText(const Value: string);
begin
  if FText <> Value then
  begin
    FText := Value;
    Invalidate;
    UpdateAutoFitWidth;
  end;
end;

procedure TDFSStatusPanel.SetTimeFormat(const Value: string);
begin
  if FTimeFormat <> Value then
  begin
    FTimeFormat := Value;
    UpdateDateTime;
  end;
end;

procedure TDFSStatusPanel.SetWidth(const Value: Integer);
begin
  if ((not FAutoFit) or (csLoading in StatusBar.ComponentState)) and
     (LinkedPanel.Width <> Value) then
    LinkedPanel.Width := Value;
  if (PanelType = sptGauge) and (GaugeAttrs.Style = gsIndeterminate) then
  begin
    FGaugeLastPos := 0;
    FGaugeDirection := 1;
    Invalidate;
  end;
end;

procedure TDFSStatusPanel.TimerNotification;
begin
  if PanelType in [sptDate, sptTime, sptDateTime] then
    UpdateDateTime
  else if (PanelType = sptGauge) and (GaugeAttrs.Style = gsIndeterminate) then
    // Call Redraw directly. It will take care of erasing the old part.  If we
    // used Invalidate, the background would get erased, too, and it would
    // flicker a lot.
    Redraw(StatusBar.Canvas, StatusBar.GetPanelRect(Index));
end;

procedure TDFSStatusPanel.UpdateAutoFitWidth;
begin
  if FAutoFit and (StatusBar <> NIL) and (StatusBar.HandleAllocated) then
  begin
    if PanelType = sptGlyph then
      LinkedPanel.Width := Glyph.Width + 4
    else
      LinkedPanel.Width := StatusBar.TextExtent(Text).cx + 6;
  end;
end;

procedure TDFSStatusPanel.UpdateDateTime;
var
  Fmt: string;
  Txt: string;
begin
  case PanelType of
    sptDate:
      if DateFormat = '' then
        Fmt := ShortDateFormat
      else
        Fmt := DateFormat;
    sptTime:
      if TimeFormat = '' then
        Fmt := LongTimeFormat
      else
        Fmt := TimeFormat;
    sptDateTime:
      begin
        if TimeFormat = '' then
          Fmt := LongTimeFormat
        else
          Fmt := TimeFormat;
        if DateFormat = '' then
          Fmt := Fmt + ' ' + ShortDateFormat
        else
          Fmt := Fmt + ' ' + DateFormat;
      end;
  end;
  Txt := FormatDateTime(Fmt, Now);
  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:
        TDFSStatusPanels(Collection).RegisterTimer(Self);
      sptGauge:
        if GaugeAttrs.Style = gsIndeterminate 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:
        TDFSStatusPanels(Collection).DeregisterTimer(Self);
      sptGauge:
        if GaugeAttrs.Style = gsIndeterminate then
          TDFSStatusPanels(Collection).DeregisterTimer(Self);
    end;
  end;

  Invalidate;
  if not Enabled then
  begin
    FGaugeLastPos := 0;
    FGaugeDirection := 1;
  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;

{ 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:
          NewTimerRes := 1000;
        sptGauge:
          if TDFSStatusPanel(FTimerClients[x]).GaugeAttrs.Style =
             gsIndeterminate 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:
      if FirstClient or (FTimer.Interval > 1000) then
        FTimer.Interval := 1000;
    sptGauge:
      if Client.GaugeAttrs.Style = gsIndeterminate 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]) or
       (DateUpdate and (Panel.PanelType = sptDate)) or
       ((Panel.PanelType = sptGauge) and
       (Panel.GaugeAttrs.Style = gsIndeterminate)) 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_3_UP}
    raise EListError.Create(SListIndexError);
    {$ELSE}
//    raise EListError.CreateRes(SListIndexError);
    {$ENDIF}
  end;
end;

function TDFSStatusBar.GetPanelRect(Index: integer): TRect;