dfsstatusbar.pas

动态提示控件

  GR.Top := GR.Top + (GR.Bottom - GR.Top - Glyph.Height) div 2;

  if Glyph.Graphic is TBitmap then
  begin
    // Draw it transparently
    Canvas.BrushCopy(Bounds(GR.Left, GR.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(GR.Left, GR.Top, Glyph.Graphic);
  if Text <> '' then
  begin
    SetTextColor(Canvas.Handle, ColorToRGB(StatusBar.Font.Color));
    case Alignment of
      taLeftJustify,
      taCenter:
        begin
          GR.Left := GR.Left + Glyph.Width + TEXT_SPACE;
          GR.Top := R.Top;
          GR.Bottom := R.Bottom;
          DrawText(Canvas.Handle, PChar(Text), -1, GR, DT_SINGLELINE or
            DT_NOPREFIX or DT_VCENTER);
        end;
      taRightJustify:
        begin
          GR.Left := GR.Left - TW - TEXT_SPACE;
          GR.Top := R.Top;
          GR.Bottom := R.Bottom;
          DrawText(Canvas.Handle, PChar(Text), -1, GR, DT_SINGLELINE or
            DT_NOPREFIX or DT_VCENTER);
        end;
    end;
  end;
end;

function TdfsStatusPanel.InitGaugeBitmap: TBitmap;
var
	r1, b1, g1, r2, b2, g2: byte;
	c1, c2: Longint;
  i: integer;
	divi: integer;
	mul: extended;
begin
	c1 := ColorToRGB(StatusBar.Color);
	c2 := ColorToRGB(GaugeAttrs.Color);
	r1 := GetRValue(c1);
  b1 := GetBValue(c1);
  g1 := GetGValue(c1);
	r2 := GetRValue(c2);
  b2 := GetBValue(c2);
  g2 := GetGValue(c2);
	Result := TBitmap.Create;
	with Result do
	begin
		Height := StatusBar.Height;
		Width := 100;
		divi := Width-1;
		Canvas.Brush.Color := clRed;
		Canvas.FillRect(Rect(0, 0, Width, Height));
		for i := 0 to divi do
		begin
			mul := (i/divi);
			Canvas.Pen.Color := RGB(trunc(r1 + (r2 - r1) * mul),
         trunc(g1 + (g2 - g1) *mul), trunc(b1 + (b2 - b1) * mul));
			Canvas.MoveTo(i, 0);
			Canvas.LineTo(i, Height);
		end;
	end;
end;

procedure TdfsStatusPanel.DrawIndeterminateGauge(Canvas: TCanvas; R: TRect);
var
	gb:TBitmap;
	gbr:TRect;
  x: integer;
begin
  inc(FGaugeLastPos, FGaugeDirection);
  case GaugeAttrs.Style of
    gsIndeterminate:
      begin
        with Canvas do
        begin
          Brush.Color := GaugeAttrs.Color;
          Pen.Color := GaugeAttrs.Color;
          gbr := R;
          InflateRect(R, 0, -((R.Bottom - R.Top) div 3));
          x := R.Bottom - R.Top;
          if (FGaugeDirection > 0) and ((FGaugeLastPos + X + 1) >=
             (R.Right - R.Left)) then
          begin
            FGaugeDirection := -GaugeAttrs.Speed;
          end else if (FGaugeDirection < 0) and (FGaugeLastPos <= 1) then
          begin
            FGaugeDirection := GaugeAttrs.Speed;
          end;
          Inc(R.Left, FGaugeLastPos);
          R.Right := R.Left + X;
          // Make it a wee bit bigger
          InflateRect(R, 1, 1);

          with R do
            Ellipse(Left, Top, Right, Bottom);
        end;
      end;

    gsIndeterminate2:
      begin
        with Canvas do
        begin
          gb := GaugeBitmap;
          if (FGaugeDirection > 0) and
             ((FGaugeLastPos+ 1) >= (R.Right - R.Left)) then
            FGaugeDirection := -FGaugeAttrs.Speed
          else if (FGaugeDirection < 0) and (FGaugeLastPos <= -gb.Width) then
            FGaugeDirection := FGaugeAttrs.Speed;
          Inc(R.Left, FGaugeLastPos);
          gbr := Rect(0, 0, gb.Width, gb.Height);
          if (r.right - r.left) > gb.width then
            r.right := r.left + gb.Width
          else
            if (r.right - r.left) < gb.width then
            begin
              if FGaugeDirection > 0 then
                gbr.Right := r.right - r.Left
              else
                gbr.Left := gbr.right - (r.right - r.left);
            end;

          if FGaugeDirection > 0 then
            CopyRect(r, gb.Canvas, gbr)
          else
            CopyRect(r, gb.Canvas,
               Rect(gbr.right-1, gbr.Bottom-1, gbr.left-1, gbr.top-1))
        end;
      end;
  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
    else
      SetTextColor(Canvas.Handle, ColorToRGB(StatusBar.Font.Color));
  end else begin
    if not Odd(GetKeyState(KEY_CODE[FPanelType])) then
      SetTextColor(Canvas.Handle, ColorToRGB(clGrayText)) // might need to be a property
    else
      SetTextColor(Canvas.Handle, ColorToRGB(StatusBar.Font.Color));
  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;
  SetTextColor(Canvas.Handle, ColorToRGB(StatusBar.Font.Color));
  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, sptTimeDate:
          TdfsStatusPanels(Collection).DeregisterTimer(Self);
        sptGauge:
          if GaugeAttrs.Style in IndeterminateGuages then
            TdfsStatusPanels(Collection).DeregisterTimer(Self);
      end;

    FPanelType := Val;
    case FPanelType of
      sptCapsLock, sptNumLock, sptScrollLock:
        begin
          Text := LOCK_TEXT[FPanelType];
          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, sptTimeDate:
        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 in IndeterminateGuages then
          begin
            Enabled := FALSE; // Enabled is false, so don't need to register
            FGaugeLastPos := 0;
            FGaugeDirection := GaugeAttrs.Speed;
          end;
        end;
    else
      AutoFit := FALSE;
    end;
    
    Invalidate;
  end;
end;


procedure TdfsStatusPanel.SetText(const Value: string);
begin
//outputdebugstring(Pchar(value));
  if FText <> Value then
  begin
//outputdebugstring(Pchar(ftext));
    FText := Value;
//outputdebugstring(Pchar(ftext));
    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 in IndeterminateGuages) then
  begin
    FGaugeLastPos := 0;
    FGaugeDirection := GaugeAttrs.Speed;
    Invalidate;
  end;
end;

procedure TdfsStatusPanel.TimerNotification;
begin
  if PanelType in [sptDate, sptTime, sptDateTime, sptTimeDate] then
    UpdateDateTime
  else if (PanelType = sptGauge) and (GaugeAttrs.Style in IndeterminateGuages) 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
    begin
      if Text = '' then
        LinkedPanel.Width := BorderWidth + Glyph.Width + 4
      else
        LinkedPanel.Width := StatusBar.TextExtent(Text).cx + 2 +
          (BorderWidth * 2) + Glyph.Width + 4;
    end
    else
      LinkedPanel.Width := StatusBar.TextExtent(Text).cx + 6 + BorderWidth;
  end;
  Invalidate;
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 DateFormat = '' then
          Fmt := ShortDateFormat
        else
          Fmt := DateFormat;
        if TimeFormat = '' then
          Fmt := Fmt + ' ' + LongTimeFormat
        else
          Fmt := Fmt + ' ' + TimeFormat;
      end;
    sptTimeDate:
      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);