flatbars.pas

comerose_flatstyle_v4.42.9.0_d7.rar

      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;

{ TFlatGauge }

constructor TFlatGauge.Create(AOwner: TComponent);
begin
  inherited Create (AOwner);
  ControlStyle := ControlStyle + [csFramed, csOpaque];
  SetBounds(0,0,145,25);
  FMinValue       := 0;
  FMaxValue       := 100;
  FProgress       := 25;
  FShowText       := True;
  FBarColor       := $00996633;
  FBorderColor    := DefaultBorderColor;
  fStyleFace      := DefaultStyleFace;
  fStyleBars      := DefaultStyleHorizontal;

  fColorStart     := DefaultColorStart;
  fColorStop      := DefaultColorStop;
  ParentColor     := true;
  fTextAfter      := '';
  fTextFront      := '';
end;

procedure TFlatGauge.Paint;
var
  barRect, solvedRect: TRect;
  PercentText: String;
  PerInt,iDrawLen:Integer;
  memBitmap: TBitmap;
begin
  barRect   := ClientRect;
  memBitmap := TBitmap.Create;
  try;
   memBitmap.Width := ClientRect.Right;
   memBitmap.Height:= ClientRect.Bottom;
   // Clear Background
   if not FTransparent then begin
    memBitmap.Canvas.Brush.Color := Color;
    memBitmap.Canvas.FillRect(barRect);
   end;

   // Draw Border
   DrawButtonBorder(memBitmap.Canvas, ClientRect, FBorderColor, 1);

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

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

   // Fill the Rect
   if fStyleFace = fsDefault then begin
      memBitmap.Canvas.Brush.Color := FBarColor;
      memBitmap.Canvas.FillRect(solvedRect);
   end else begin
      DrawBackdrop(memBitmap.Canvas,fColorStart,fColorStop,solvedRect,fStyleBars);
   end;
   // Draw Text
   if FShowText then begin
    PerInt      := Trunc(((FProgress-FMinValue)/(FMaxValue-FMinValue)) * 100);
    PercentText := format('%s%3d%%%s',[fTextFront,PerInt,fTextAfter]);
    memBitmap.Canvas.Font.Assign(Self.Font);
    memBitmap.Canvas.Brush.Style := bsClear;
    DrawText(memBitmap.Canvas.Handle, PChar(PercentText), Length(PercentText), barRect, DT_CENTER or DT_VCENTER or DT_SINGLELINE);
    // bar is under caption
    IntersectClipRect(memBitmap.canvas.handle, solvedrect.left, solvedrect.top, solvedrect.right, solvedrect.bottom);
    memBitmap.Canvas.Font.Color := color;
    DrawText(memBitmap.Canvas.Handle, PChar(PercentText), Length(PercentText), barRect, DT_CENTER or DT_VCENTER or DT_SINGLELINE);
   end;
   canvas.Lock;
   Canvas.CopyMode := cmSrcCopy;
   canvas.CopyRect(ClientRect, memBitmap.canvas, ClientRect);
   canvas.Unlock;
  finally
   memBitmap.Free;
  end;
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;
    2: fColorStart  := Value;
    3: fColorStop   := 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.SetTextAfter(const Value: TCaption);
begin
   if fTextAfter <> Value then begin
      fTextAfter := Value;
      Invalidate;
   end;
end;

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

procedure TFlatGauge.SetStyleOrien(const Value: TStyleOrien);
begin
  if fStyleBars <> Value then begin
     fStyleBars := Value;
     Invalidate;
  end;
end;

procedure TFlatGauge.SetStyleFace(const Value: TStyleFace);
begin
  if fStyleFace <> Value then begin
     fStyleFace := Value;
     Invalidate;
  end;
end;

end.