dfsstatusbar.pas

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

  if FPosition <> Value then
  begin
    FPosition := Value;
    FOwner.Invalidate;
  end;
end;

procedure TDFSGaugeAttrs.SetStyle(const Value: TDFSGaugeStyle);
begin
  if FStyle <> Value then
  begin
    if (Owner.PanelType = sptGauge) and (FStyle = gsIndeterminate) and
       Owner.Enabled then
      TDFSStatusPanels(Owner.Collection).DeregisterTimer(Owner);
    FStyle := Value;
    FOwner.Invalidate;
    if (Owner.PanelType = sptGauge) and (FStyle = gsIndeterminate) and
       Owner.Enabled then
      TDFSStatusPanels(Owner.Collection).RegisterTimer(Owner);
  end;
end;


{ TDFSStatusPanel }

procedure TDFSStatusPanel.Assign(Source: TPersistent);
var
  SrcPanel: TDFSStatusPanel absolute Source;
begin
  if Source is TDFSStatusPanel then
  begin
{    if LinkedPanel <> NIL then
      LinkedPanel.Free;
    LinkedPanel := SrcPanel.FLinkedPanel;}

    GaugeAttrs.Assign(SrcPanel.GaugeAttrs);
    Alignment := SrcPanel.Alignment;
    Bevel := SrcPanel.Bevel;
{$IFDEF DFS_COMPILER_4_UP}
    BiDiMode := SrcPanel.BiDiMode;
    ParentBiDiMode := SrcPanel.ParentBiDiMode;
{$ENDIF}
    Glyph.Assign(SrcPanel.Glyph);
    Text := SrcPanel.Text;
    DateFormat := SrcPanel.DateFormat;
    TimeFormat := SrcPanel.TimeFormat;
    Enabled := SrcPanel.Enabled;
    Width := SrcPanel.Width;
    AutoFit := SrcPanel.AutoFit;
    Hint := SrcPanel.Hint;

    OnDrawPanel := SrcPanel.OnDrawPanel;
    OnHintText := SrcPanel.OnHintText;

    // Do last!
    PanelType := SrcPanel.PanelType;
  end else
    inherited Assign(Source);
end;

constructor TDFSStatusPanel.Create(AOwner: TCollection);
begin
  inherited Create(AOwner);

  if AOwner is TDFSStatusPanels then
  begin
    TDFSStatusPanels(AOwner).FLinkedPanels.Add;
    LinkedPanel.Style := psOwnerDraw;
  end else
    raise Exception.Create('TDFSStatusPanel owner must be TDFSStatusPanesls');
  FKeyOn := FALSE;
  FGaugeLastPos := 0;
  FGaugeDirection := 1;
  FPanelType := sptNormal;
  FAutoFit := FALSE;
  FEnabled := TRUE;
  FTimeFormat := '';
  FDateFormat := '';
  FGaugeAttrs := TDFSGaugeAttrs.Create(Self);
  FGlyph := TPicture.Create;
  FGlyph.OnChange := GlyphChanged;
end;


destructor TDFSStatusPanel.Destroy;
begin
  if Enabled then
    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;

  FGlyph.Free;
  FGaugeAttrs.Free;
  TDFSStatusPanels(Collection).FLinkedPanels[Index].Free;

  inherited Destroy;
end;


function TDFSStatusPanel.GetAlignment: TAlignment;
begin
  Result := LinkedPanel.Alignment
end;

function TDFSStatusPanel.GetBevel: TStatusPanelBevel;
begin
  Result := LinkedPanel.Bevel
end;

{$IFDEF DFS_COMPILER_4_UP}
function TDFSStatusPanel.GetBiDiMode: TBiDiMode;
begin
  Result := LinkedPanel.BiDiMode
end;

function TDFSStatusPanel.GetParentBiDiMode: Boolean;
begin
  Result := LinkedPanel.ParentBiDiMode
end;
{$ENDIF}

function TDFSStatusPanel.GetStatusBar: TDFSStatusBar;
begin
  Result := TDFSStatusPanels(Collection).FStatusBar;
end;

function TDFSStatusPanel.GetWidth: Integer;
begin
  Result := LinkedPanel.Width
end;

procedure TDFSStatusPanel.Invalidate;
begin
  if StatusBar <> NIL then
    StatusBar.InvalidatePanel(Index);
end;

{$IFDEF DFS_COMPILER_4_UP}
function TDFSStatusPanel.IsBiDiModeStored: Boolean;
begin
  Result := not ParentBiDiMode;
end;
{$ENDIF}

procedure TDFSStatusPanel.Redraw(Canvas: TCanvas; Dest: TRect);
var
  Buffer: TBitmap;
  R: TRect;
begin
  if (not StatusBar.HandleAllocated) or (IsRectEmpty(Dest))then
    exit;

  InflateRect(Dest, -1, -1); // Don't paint over the shadows.

  R := Dest;
  OffsetRect(R, -Dest.Left, -Dest.Top);
  Buffer := TBitmap.Create;
  try
    Buffer.Width := R.Right;
    Buffer.Height := R.Bottom;

    Buffer.Canvas.Font.Handle := CopyHFont(Canvas.Font.Handle);
    Buffer.Canvas.Brush.Color := StatusBar.Color;
    Buffer.Canvas.FillRect(R);

    if Enabled then
    begin
      case PanelType of
        sptCapsLock, sptNumLock, sptScrollLock:
          DrawKeyLock(Buffer.Canvas, R);

        sptNormal, sptDate, sptTime, sptDateTime, sptEllipsisText,
        sptEllipsisPath, sptOwnerDraw:
          begin
            if (PanelType = sptOwnerDraw) and
               not (csDesigning in StatusBar.ComponentState) then
              exit;
            DrawTextBased(Buffer.Canvas, R);
          end;

          sptGlyph:
            DrawGlyph(Buffer.Canvas, R);

          sptGauge:
            if GaugeAttrs.Style = gsIndeterminate then
              DrawIndeterminateGauge(Buffer.Canvas, R)
            else
              DrawGauge(Buffer.Canvas, R);
      end;
    end;

    Canvas.Draw(Dest.Left, Dest.Top, Buffer);
  finally
    Buffer.Free;
  end;
end;

procedure TDFSStatusPanel.DrawGauge(Canvas: TCanvas; R: TRect);
var
  R1, R2: TRect;
  R1Rgn, R2Rgn, OldRgn: HRGN;
  Pct: string;
  OldColor: TColorRef;
  DTFlags: UINT;
begin
  R1 := R;
  R2 := R;
  R1.Right := R1.Left + MulDiv(R.Right-R.Left, FGaugeAttrs.Position, 100);
  with Canvas do
  begin
    Brush.Color := clHighlight;
    FillRect(R1);
    R2.Left := R1.Right;
    Brush.Color := StatusBar.Color;
    FillRect(R2);

    { This could probably be simplified with ExtTextOut and SetTextAlign now
      things are being properly buffered off-screen.  But, this is working and
      doesn't seem slow, so....  "If it ain't broke, don't fix it."  :)        }
    if Text = '' then
      Pct := IntToStr(FGaugeAttrs.Position) + '%'
    else
      Pct := Text; // Use what's in the panel's text property.
    // don't change background color behind text!
    Brush.Style := bsClear;
    OldColor := GetTextColor(Handle);

    R1Rgn := CreateRectRgnIndirect(R1);
    R2Rgn := CreateRectRgnIndirect(R2);
    OldRgn := CreateRectRgn(0, 0, 1, 1);
    try
      GetClipRgn(Handle, OldRgn);

      DTFlags := DT_VCENTER or DT_NOPREFIX or DT_SINGLELINE;
      case Alignment of
        taCenter:       DTFlags := DTFlags or DT_CENTER;
        taRightJustify: DTFlags := DTFlags or DT_RIGHT;
      end;
      // Draw the text in the "filled" area with clHighlight color
      if (R1Rgn<>0) and (SelectClipRgn(Handle, R1Rgn) <> ERROR) then
        try
          SetTextColor(Handle, ColorToRGB(clHighlightText));
          DrawText(Handle, PChar(Pct), -1, R, DTFlags);
        finally
          SelectClipRgn(Handle, OldRgn);
        end;

      // Draw the text in the "empty" area with normal color
      if (R2Rgn<>0) and (SelectClipRgn(Handle, R2Rgn) <> ERROR) then
        try
          SetTextColor(Handle, OldColor);
          DrawText(Handle, PChar(Pct), -1, R, DTFlags);
        finally
          SelectClipRgn(Handle, OldRgn);
        end;
    finally
      DeleteObject(R1Rgn);
      DeleteObject(R2Rgn);
      DeleteObject(OldRgn);
    end;
  end;
end;

procedure TDFSStatusPanel.DrawGlyph(Canvas: TCanvas; R: TRect);
begin
  if (Alignment = taCenter) or AutoFit then
     with R do
       Left := Left + ((Right - Left - Glyph.Width) div 2)
  else if Alignment = taRightJustify then
    R.Left := R.Right - Glyph.Width;
  R.Top := (R.Bottom - Glyph.Height) div 2;

  if Glyph.Graphic is TBitmap then
  begin
    // Draw it transparently
    Canvas.BrushCopy(Bounds(R.Left, R.Top, Glyph.Width,
       Glyph.Height), Glyph.Bitmap, Rect(0, 0, Glyph.Width,
       Glyph.Height), Glyph.Bitmap.Canvas.Pixels[0, Glyph.Height-1]);
  end else
    Canvas.Draw(R.Left, R.Top, Glyph.Graphic);
end;

procedure TDFSStatusPanel.DrawIndeterminateGauge(Canvas: TCanvas; R: TRect);

  function BallRect(const Src: TRect): TRect;
  var
    x: integer;
  begin
     Result := Src;
     InflateRect(Result, 0, -((Result.Bottom - Result.Top) div 3));
     x := Result.Bottom - Result.Top;
     if (FGaugeDirection = 1) and ((FGaugeLastPos+ X + 1) >=
        (Result.Right - Result.Left)) then
       FGaugeDirection := -1
     else if (FGaugeDirection = -1) and (FGaugeLastPos <= 1) then
       FGaugeDirection := 1;
     Inc(Result.Left, FGaugeLastPos);
     Result.Right := Result.Left + X;
     // Make it a wee bit bigger
     InflateRect(Result, 1, 1);
  end;

begin
  with Canvas do
  begin
    inc(FGaugeLastPos, FGaugeDirection);
    Brush.Color := clHighlight;
    Pen.Color := clHighlight;
    with BallRect(R) do
      Ellipse(Left, Top, Right, Bottom);
  end;
end;

procedure TDFSStatusPanel.DrawKeyLock(Canvas: TCanvas; R: TRect);
var
  DTFlags: UINT;
  OldColor: TColorRef;
begin
  OldColor := GetTextColor(Canvas.Handle);
  if StatusBar.UseMonitorDLL then
  begin
    if not FKeyOn then
      SetTextColor(Canvas.Handle, ColorToRGB(clGrayText)); // might need to be a property
  end else begin
    if not Odd(GetKeyState(KEY_CODE[FPanelType])) then
      SetTextColor(Canvas.Handle, ColorToRGB(clGrayText)); // might need to be a property
  end;
  DTFlags := DT_SINGLELINE or DT_NOPREFIX or DT_VCENTER;
  if AutoFit then
    DTFLags := DTFlags or DT_CENTER
  else
    case Alignment of
      taCenter:       DTFlags := DTFlags or DT_CENTER;
      taRightJustify: DTFlags := DTFlags or DT_RIGHT;
    end;
  DrawText(Canvas.Handle, PChar(Text), -1, R, DTFlags);
  SetTextColor(Canvas.Handle, OldColor);
end;

procedure TDFSStatusPanel.DrawTextBased(Canvas: TCanvas; R: TRect);
var
  DTFlags: UINT;
begin
  DTFlags := DT_SINGLELINE or DT_NOPREFIX or DT_VCENTER;
  if AutoFit then
    DTFLags := DTFlags or DT_CENTER
  else
    case Alignment of
      taCenter:       DTFlags := DTFlags or DT_CENTER;
      taRightJustify:
        begin
          dec(R.Right);
          DTFlags := DTFlags or DT_RIGHT;
        end;
    end;
  case PanelType of
    sptEllipsisPath: DTFlags := DTFlags or DT_PATH_ELLIPSIS;
    sptEllipsisText: DTFlags := DTFlags or DT_END_ELLIPSIS;
  end;
  if PanelType = sptOwnerDraw then
    // This only happens when in design mode, see Redraw method.
    DrawText(Canvas.Handle, ' *OD* ', -1, R, DTFlags)
  else
    DrawText(Canvas.Handle, PChar(Text), -1, R, DTFlags);
end;

procedure TDFSStatusPanel.SetAlignment(const Value: TAlignment);
begin
  if LinkedPanel.Alignment <> Value then
  begin
    LinkedPanel.Alignment := Value;
    Invalidate;
  end;
end;

procedure TDFSStatusPanel.SetAutoFit(const Value: boolean);
begin
  if FAutoFit <> Value then
  begin
    FAutoFit := Value;
    UpdateAutoFitWidth;
  end;
end;

procedure TDFSStatusPanel.SetBevel(const Value: TStatusPanelBevel);
begin
  if LinkedPanel.Bevel <> Value then
    LinkedPanel.Bevel := Value;
end;

{$IFDEF DFS_COMPILER_4_UP}
procedure TDFSStatusPanel.SetBiDiMode(const Value: TBiDiMode);
begin
  if LinkedPanel.BiDiMode <> Value then
    LinkedPanel.BiDiMode := Value;
end;

procedure TDFSStatusPanel.SetParentBiDiMode(const Value: Boolean);
begin
  if LinkedPanel.ParentBiDiMode <> Value then
    LinkedPanel.ParentBiDiMode := Value;
end;

{$ENDIF}

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

procedure TDFSStatusPanel.SetEnabled(const Value: boolean);
begin
  if FEnabled <> Value then
  begin
    FEnabled := Value;
    EnabledChanged;
  end;
end;

procedure TDFSStatusPanel.SetGlyph(const Value: TPicture);
begin
  FGlyph.Assign(Value);
  // GlyphChanged method will take care of updating display.
end;

procedure TDFSStatusPanel.SetPanelType(const Val: TDFSStatusPanelType);
const
  LOCK_TEXT: array[sptCapsLock..sptScrollLock] of string = (
     SCapsLock, SNumLock, SScrollLock
    );
begin
  if Val <> FPanelType then
  begin
    if Enabled then
      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;

    FPanelType := Val;
    case FPanelType of
      sptCapsLock, sptNumLock, sptScrollLock:
        begin
          Text := LOCK_TEXT[FPanelType];