flatbars.pas

相信大家已经找很长时间了

  FTrack.Position := FPosition;
end;

procedure TFlatScrollbar.SetKind(Value: TScrollBarKind);
var
  i: Integer;
begin
  if FKind <> Value then
  begin
    FKind := Value;
    FTrack.Kind := FKind;
    if FKind = sbVertical then
    begin
      FBtnOne.Glyph.LoadFromResourceName(hInstance,'THUMB_UP_ENABLED');
      FBtnOne.Refresh;
      FBtnTwo.Glyph.LoadFromResourceName(hInstance,'THUMB_DOWN_ENABLED');
      FBtnTwo.Refresh;
    end
    else
    begin
      FBtnOne.Glyph.LoadFromResourceName(hInstance,'THUMB_LEFT_ENABLED');
      FBtnOne.Refresh;
      FBtnTwo.Glyph.LoadFromResourceName(hInstance,'THUMB_RIGHT_ENABLED');
      FBtnTwo.Refresh;
    end;
    if (csDesigning in ComponentState) and not (csLoading in ComponentState) then
    begin
      i := Width;
      Width := Height;
      Height := i;
    end;
  end;
end;

procedure TFlatScrollbar.SetButtonHighlightColor(Value: TColor);
begin
  if Value <> FButtonHighlightColor then
  begin
    FButtonHighlightColor := Value;
    FBtnOne.ColorHighlight := ButtonHighlightColor;
    FBtnTwo.ColorHighlight := ButtonHighlightColor;
  end;
end;

procedure TFlatScrollbar.SetButtonShadowColor(Value: TColor);
begin
  if Value <> FButtonShadowColor then
  begin
    FButtonShadowColor := Value;
    FBtnOne.ColorShadow := ButtonShadowColor;
    FBtnTwo.ColorShadow := ButtonShadowColor;
  end;
end;

procedure TFlatScrollbar.SetButtonBorderColor(Value: TColor);
begin
  if Value <> FButtonBorderColor then
  begin
    FButtonBorderColor := Value;
    FBtnOne.ColorBorder := ButtonBorderColor;
    FBtnTwo.ColorBorder := ButtonBorderColor;
  end;
end;

procedure TFlatScrollbar.SetButtonFocusedColor(Value: TColor);
begin
  if Value <> FButtonFocusedColor then
  begin
    FButtonFocusedColor := Value;
    FBtnOne.ColorFocused := ButtonFocusedColor;
    FBtnTwo.ColorFocused := ButtonFocusedColor;
  end;
end;

procedure TFlatScrollbar.SetButtonDownColor(Value: TColor);
begin
  if Value <> FButtonDownColor then
  begin
    FButtonDownColor := Value;
    FBtnOne.ColorDown := ButtonDownColor;
    FBtnTwo.ColorDown := ButtonDownColor;
  end;
end;

procedure TFlatScrollbar.SetButtonColor(Value: TColor);
begin
  if Value <> FButtonColor then
  begin
    FButtonColor := Value;
    FBtnOne.Color := ButtonColor;
    FBtnTwo.Color := ButtonColor;
  end;
end;

procedure TFlatScrollbar.SetThumbHighlightColor(Value: TColor);
begin
  if Value <> FThumbHighlightColor then
  begin
    FThumbHighlightColor := Value;
    FTrack.DoThumbHighlightColor(Value);
  end;
end;

procedure TFlatScrollbar.SetThumbShadowColor(Value: TColor);
begin
  if Value <> FThumbShadowColor then
  begin
    FThumbShadowColor := Value;
    FTrack.DoThumbShadowColor(Value);
  end;
end;

procedure TFlatScrollbar.SetThumbBorderColor(Value: TColor);
begin
  if Value <> FThumbBorderColor then
  begin
    FThumbBorderColor := Value;
    FTrack.DoThumbBorderColor(Value);
  end;
end;

procedure TFlatScrollbar.SetThumbFocusedColor(Value: TColor);
begin
  if Value <> FThumbFocusedColor then
  begin
    FThumbFocusedColor := Value;
    FTrack.DoThumbFocusedColor(Value);
  end;
end;

procedure TFlatScrollbar.SetThumbDownColor(Value: TColor);
begin
  if Value <> FThumbDownColor then
  begin
    FThumbDownColor := Value;
    FTrack.DoThumbDownColor(Value);
  end;
end;

procedure TFlatScrollbar.SetThumbColor(Value: TColor);
begin
  if Value <> FThumbColor then
  begin
    FThumbColor := Value;
    FTrack.DoThumbColor(Value);
  end;
end;

procedure TFlatScrollbar.BtnOneClick(Sender: TObject);
var
  iPosition: Integer;
begin
  iPosition := Position;
  Dec(iPosition,SmallChange);
  Position := iPosition;
end;

procedure TFlatScrollbar.BtnTwoClick(Sender: TObject);
var
  iPosition: Integer;
begin
  iPosition := Position;
  Inc(iPosition,SmallChange);
  Position := iPosition;
end;

procedure TFlatScrollbar.EnableBtnOne(Value: Boolean);
begin
  if Value = True then
  begin
    FBtnOne.Enabled := True;
    case FKind of
      sbVertical: FBtnOne.Glyph.LoadFromResourceName(hInstance,'THUMB_UP_ENABLED');
      sbHorizontal: FBtnOne.Glyph.LoadFromResourceName(hInstance,'THUMB_LEFT_ENABLED');
    end;
  end
  else
  begin
    case FKind of
      sbVertical: FBtnOne.Glyph.LoadFromResourceName(hInstance,'THUMB_UP_DISABLED');
      sbHorizontal: FBtnOne.Glyph.LoadFromResourceName(hInstance,'THUMB_LEFT_DISABLED');
    end;
    FBtnOne.Enabled := False;
  end;
end;

procedure TFlatScrollbar.EnableBtnTwo(Value: Boolean);
begin
  if Value = True then
  begin
    FBtnTwo.Enabled := True;
    case FKind of
      sbVertical: FBtnTwo.Glyph.LoadFromResourceName(hInstance,'THUMB_DOWN_ENABLED');
      sbHorizontal: FBtnTwo.Glyph.LoadFromResourceName(hInstance,'THUMB_RIGHT_ENABLED');
    end;
  end
  else
  begin
    case FKind of
      sbVertical: FBtnTwo.Glyph.LoadFromResourceName(hInstance,'THUMB_DOWN_DISABLED');
      sbHorizontal: FBtnTwo.Glyph.LoadFromResourceName(hInstance,'THUMB_RIGHT_DISABLED');
    end;
    FBtnTwo.Enabled := False;
  end;
end;

procedure TFlatScrollbar.WMSize(var Message: TWMSize);
begin
  if FKind = sbVertical then
  begin
    SetBounds(Left, Top, Width, Height);
    FBtnOne.SetBounds(0,0,Width,17);
    FBtnTwo.SetBounds(0,Height - 17,Width,17);
    FTrack.SetBounds(0,17,Width,Height - 34);
  end
  else
  begin
    SetBounds(Left, Top, Width, Height);
    FBtnOne.SetBounds(0,0,17,Height);
    FBtnTwo.SetBounds(Width - 17,0,17,Height);
    FTrack.SetBounds(17,0,Width - 34,Height);
  end;
  Position := FPosition;
end;

procedure TFlatScrollbar.DoScroll;
begin
  if Assigned(FOnScroll) then FOnScroll(Self,Position);
end;

{ These scrollbar messages are just passed onto the TFlatScrollbarTrack for handling }

procedure TFlatScrollbar.CNHScroll(var Message: TWMScroll);
begin
  FTrack.DoHScroll(Message);
end;

procedure TFlatScrollbar.CNVScroll(var Message: TWMScroll);
begin
  FTrack.DoVScroll(Message);
end;

procedure TFlatScrollbar.SBMEnableArrows(var Message: TMessage);
begin
  FTrack.DoEnableArrows(Message);
end;

procedure TFlatScrollbar.SBMGetPos(var Message: TMessage);
begin
  FTrack.DoGetPos(Message);
end;

procedure TFlatScrollbar.SBMGetRange(var Message: TMessage);
begin
  FTrack.DoGetRange(Message);
end;

procedure TFlatScrollbar.SBMSetPos(var Message: TMessage);
begin
  FTrack.DoSetPos(Message);
end;

procedure TFlatScrollbar.SBMSetRange(var Message: TMessage);
begin
  FTrack.DoSetRange(Message);
end;

{ This message handler handles keyboard events }

procedure TFlatScrollbar.WMKeyDown(var Message: TWMKeyDown);
begin
  FTrack.DoKeyDown(Message); { Problems? }
end;

constructor TFlatGauge.Create(AOwner: TComponent);
begin
  inherited Create (AOwner);
  Width    := 145;
  Height   := 25;
  Min      := 0;
  Max      := 100;
  Progress := 25;
  ShowText := True;
  BarColor := $00996633;
  ColorBorder := $004080FF;
  ParentColor := true;
  fText    := '';
end;

procedure TFlatGauge.Paint;
var
  barRect, solvedRect: TRect;
  PercentText: String;
begin
  Canvas.Lock;
  barRect := ClientRect;

  // Clear Background
  if not FTransparent then
  begin
    Canvas.Brush.Color := Color;
    Canvas.FillRect(barRect);
  end;

  // Draw Border
  Frame3DBorder(Canvas, ClientRect, FBorderColor, FBorderColor, 1);

  // Calculate the Rect
  InflateRect(barRect, -2, -2);

  {$IFDEF DFS_COMPILER_4_UP}
  if BidiMode = bdRightToLeft then
    solvedRect := Rect(barRect.right - Trunc((barRect.right - barRect.left) / (FMaxValue - FMinValue) * FProgress),
      barRect.top, barRect.right, barRect.bottom)
  else
    solvedRect := Rect(barRect.left, barRect.top,
      barRect.left + Trunc((barRect.right - barRect.left) / (FMaxValue - FMinValue) * FProgress),
      barRect.bottom);
  {$ELSE}
  solvedRect := Rect(barRect.left, barRect.top,
    barRect.left + Trunc((barRect.right - barRect.left) / (FMaxValue - FMinValue) * FProgress),
    barRect.bottom);
  {$ENDIF}

  // Fill the Rect
  Canvas.Brush.Color := FBarColor;
  Canvas.FillRect(solvedRect);

  // Draw Text
  if FShowText then
  begin
    PercentText := fText + IntToStr(Trunc(((FProgress-FMinValue)/(FMaxValue-FMinValue)) * 100)) + ' %';
    Canvas.Font.Assign(Self.Font);
    Canvas.Brush.Style := bsClear;
    DrawText(Canvas.Handle, PChar(PercentText), Length(PercentText), barRect, DT_CENTER or DT_VCENTER or DT_SINGLELINE);
    // bar is under caption
    IntersectClipRect(canvas.handle, solvedrect.left, solvedrect.top, solvedrect.right, solvedrect.bottom);
    Canvas.Font.Color := color;
    DrawText(Canvas.Handle, PChar(PercentText), Length(PercentText), barRect, DT_CENTER or DT_VCENTER or DT_SINGLELINE);
  end;
  Canvas.Unlock;
end;

procedure TFlatGauge.SetShowText(Value: Boolean);
begin
  if FShowText <> Value then
  begin
    FShowText := Value;
    Repaint;
  end;
end;

procedure TFlatGauge.SetMinValue(Value: Longint);
begin
  if Value <> FMinValue then
  begin
    if Value > FMaxValue then
      FMinValue := FMaxValue
    else
      FMinValue := Value;
    if FProgress < Value then FProgress := Value;
      Repaint;
  end;
end;

procedure TFlatGauge.SetMaxValue(Value: Longint);
begin
  if Value <> FMaxValue then
  begin
    if Value < FMinValue then
      FMaxValue := FMinValue
    else
      FMaxValue := Value;
    if FProgress > Value then FProgress := Value;
      Repaint;
  end;
end;

procedure TFlatGauge.SetProgress(Value: Longint);
begin
  if Value < FMinValue then
    Value := FMinValue
  else
    if Value > FMaxValue then
      Value := FMaxValue;
  if FProgress <> Value then
  begin
    FProgress := Value;
    Repaint;
  end;
end;

procedure TFlatGauge.SetColors (Index: Integer; Value: TColor);
begin
  case Index of
    0: FBorderColor := Value;
    1: FBarColor := Value;
  end;
  Invalidate;
end;

procedure TFlatGauge.CalcAdvColors;
begin
  if FUseAdvColors then
  begin
    FBorderColor := CalcAdvancedColor(Color, FBorderColor, FAdvColorBorder, darken);
  end;
end;

procedure TFlatGauge.SetAdvColors (Index: Integer; Value: TAdvColors);
begin
  case Index of
    0: FAdvColorBorder := Value;
  end;
  CalcAdvColors;
  Invalidate;
end;

procedure TFlatGauge.SetUseAdvColors (Value: Boolean);
begin
  if Value <> FUseAdvColors then
  begin
    FUseAdvColors := Value;
    ParentColor := Value;
    CalcAdvColors;
    Invalidate;
  end;
end;

procedure TFlatGauge.CMSysColorChange (var Message: TMessage);
begin
  if FUseAdvColors then
  begin
    ParentColor := True;
    CalcAdvColors;
  end;
  Invalidate;
end;

procedure TFlatGauge.CMParentColorChanged (var Message: TWMNoParams);
begin
  inherited;
  if FUseAdvColors then
  begin
    ParentColor := True;
    CalcAdvColors;
  end;
  Invalidate;
end;

procedure TFlatGauge.SetTransparent(const Value: Boolean);
begin
  FTransparent := Value;
  Invalidate;
end;

{$IFDEF DFS_COMPILER_4_UP}
procedure TFlatGauge.SetBiDiMode(Value: TBiDiMode);
begin
  inherited;
  Invalidate;
end;
{$ENDIF}

procedure TFlatGauge.SetText(const Value: TCaption);
begin
  if fText <> Value then
   begin
     fText := Value;
     Invalidate;
   end;   
end;

end.