flatbars.pas

comerose_flatstyle_v4.42.9.0_d7.rar

  FThumb.ColorShadow := ecLightBrown;
  FThumb.Height := 17;
  InsertControl(FThumb);

  FMin := 0;
  FMax := 100;
  FSmallChange := 1;
  FLargeChange := 1;
  FPosition := 0;

  FThumb.Top := ThumbFromPosition;
end;

destructor TFlatScrollbarTrack.Destroy;
begin
  FThumb.Free;
  inherited Destroy;
end;

procedure TFlatScrollbarTrack.Paint;
begin
  with Canvas do
  begin
    Brush.Color := Color;
    FillRect(ClientRect);
  end;
end;

procedure TFlatScrollbarTrack.SetSmallChange(Value: Integer);
begin
  if Value <> FSmallChange then
  begin
    FSmallChange := Value;
  end;
end;

procedure TFlatScrollbarTrack.SetLargeChange(Value: Integer);
begin
  if Value <> FLargeChange then
  begin
    FLargeChange := Value;
  end;
end;

procedure TFlatScrollbarTrack.SetMin(Value: Integer);
begin
  if Value <> FMin then
  begin
    FMin := Value;
    FThumb.Top := ThumbFromPosition;
  end;
end;

procedure TFlatScrollbarTrack.SetMax(Value: Integer);
begin
  if Value <> FMax then
  begin
    FMax := Value;
    FThumb.Top := ThumbFromPosition;
  end;
end;

procedure TFlatScrollbarTrack.SetPosition(Value: Integer);
begin
  FPosition := Value;
  if Position > Max then
  begin
    Position := Max;
  end;
  if Position < Min then
  begin
    Position := Min;
  end;
  case FKind of
    sbVertical: FThumb.Top := ThumbFromPosition;
    sbHorizontal: FThumb.Left := ThumbFromPosition;
  end;
end;

procedure TFlatScrollbarTrack.SetKind(Value: TScrollBarKind);
begin
  if Value <> FKind then
  begin
    FKind:= Value;
    case FKind of
      sbVertical: FThumb.Height := 17;
      sbHorizontal: FThumb.Width := 17;
    end;
  end;
  Position := FPosition;
end;

procedure TFlatScrollbarTrack.WMSize(var Message: TMessage);
begin
  if FKind = sbVertical then
  begin
    FThumb.Width := Width;
  end
  else
  begin
    FThumb.Height := Height;
   end;
end;

function TFlatScrollbarTrack.ThumbFromPosition: Integer;
var
  iHW, iMin, iMax, iPosition, iResult: Integer;
begin
  iHW := 0;
  case FKind of
    sbVertical: iHW := Height - FThumb.Height;
    sbHorizontal: iHW := Width - FThumb.Width;
  end;
  iMin := FMin;
  iMax := FMax;
  iPosition := FPosition;
  iResult := Round((iHW / (iMax - iMin)) * iPosition);
  Result := iResult;
end;

function TFlatScrollbarTrack.PositionFromThumb: Integer;
var
  iHW, iMin, iMax, iPosition, iResult: Integer;
begin
  iHW := 0;
  case FKind of
    sbVertical: iHW :=  Height - FThumb.Height;
    sbHorizontal: iHW := Width - FThumb.Width;
  end;
  iMin := FMin;
  iMax := FMax;
  iPosition := 0;
  case FKind of
    sbVertical: iPosition := FThumb.Top;
    sbHorizontal: iPosition := FThumb.Left;
  end;
  iResult := Round(iPosition / iHW * (iMax - iMin));
  Result := iResult;
end;

procedure TFlatScrollbarTrack.DoPositionChange;
begin
  TFlatScrollbar(Parent).FPosition := Position;
  TFlatScrollbar(Parent).DoScroll;
end;

procedure TFlatScrollbarTrack.DoThumbHighlightColor(Value: TColor);
begin
  //FThumb.ColorHighlight := Value;
end;

procedure TFlatScrollbarTrack.DoThumbShadowColor(Value: TColor);
begin
  FThumb.ColorShadow := Value;
end;

procedure TFlatScrollbarTrack.DoThumbBorderColor(Value: TColor);
begin
  FThumb.ColorBorder := Value;
end;

procedure TFlatScrollbarTrack.DoThumbFocusedColor(Value: TColor);
begin
  FThumb.ColorFocused := Value;
end;

procedure TFlatScrollbarTrack.DoThumbDownColor(Value: TColor);
begin
  FThumb.ColorDown := Value;
end;

procedure TFlatScrollbarTrack.DoThumbColor(Value: TColor);
begin
 FThumb.Color := Value;
end;

procedure TFlatScrollbarTrack.DoHScroll(var Message: TWMScroll);
var
  iPosition: Integer;
begin
  case Message.ScrollCode of
    SB_BOTTOM: Position := Max;
    SB_LINELEFT: begin
                iPosition := Position;
                Dec(iPosition,SmallChange);
                Position := iPosition;
               end;
    SB_LINERIGHT: begin
                 iPosition := Position;
                 Inc(iPosition,SmallChange);
                 Position := iPosition;
                end;
    SB_PAGELEFT: begin
                iPosition := Position;
                Dec(iPosition,LargeChange);
                Position := iPosition;
               end;
    SB_PAGERIGHT: begin
                 iPosition := Position;
                 Inc(iPosition,LargeChange);
                 Position := iPosition;
                end;
    SB_THUMBPOSITION, SB_THUMBTRACK: Position := Message.Pos;
    SB_TOP: Position := Min;
  end;
  Message.Result := 0;
end;

procedure TFlatScrollbarTrack.DoVScroll(var Message: TWMScroll);
var
  iPosition: Integer;
begin
  case Message.ScrollCode of
    SB_BOTTOM: Position := Max;
    SB_LINEUP: begin
                iPosition := Position;
                Dec(iPosition,SmallChange);
                Position := iPosition;
               end;
    SB_LINEDOWN: begin
                 iPosition := Position;
                 Inc(iPosition,SmallChange);
                 Position := iPosition;
                end;
    SB_PAGEUP: begin
                iPosition := Position;
                Dec(iPosition,LargeChange);
                Position := iPosition;
               end;
    SB_PAGEDOWN: begin
                 iPosition := Position;
                 Inc(iPosition,LargeChange);
                 Position := iPosition;
                end;
    SB_THUMBPOSITION, SB_THUMBTRACK: Position := Message.Pos;
    SB_TOP: Position := Min;
  end;
  Message.Result := 0;
end;

procedure TFlatScrollbarTrack.DoEnableArrows(var Message: TMessage);
begin
  if Message.WParam = ESB_DISABLE_BOTH then
  begin
    TFlatScrollbar(Parent).EnableBtnOne(False);
    TFlatScrollbar(Parent).EnableBtnTwo(False);
  end;
  if Message.WParam = ESB_DISABLE_DOWN then
  begin
    if FKind = sbVertical then TFlatScrollbar(Parent).EnableBtnTwo(False);
  end;
  if Message.WParam = ESB_DISABLE_LTUP then
  begin
    TFlatScrollbar(Parent).EnableBtnOne(False);
  end;
  if Message.WParam = ESB_DISABLE_LEFT then
  begin
    if FKind = sbHorizontal then TFlatScrollbar(Parent).EnableBtnOne(False);
  end;
  if Message.WParam = ESB_DISABLE_RTDN then
  begin
    TFlatScrollbar(Parent).EnableBtnTwo(False);
  end;
  if Message.WParam = ESB_DISABLE_UP then
  begin
    if FKind = sbVertical then TFlatScrollbar(Parent).EnableBtnOne(False);
  end;
  if Message.WParam = ESB_ENABLE_BOTH then
  begin
    TFlatScrollbar(Parent).EnableBtnOne(True);
    TFlatScrollbar(Parent).EnableBtnTwo(True);
  end;
  Message.Result := 1;
end;

procedure TFlatScrollbarTrack.DoGetPos(var Message: TMessage);
begin
  Message.Result := Position;
end;

procedure TFlatScrollbarTrack.DoGetRange(var Message: TMessage);
begin
  Message.WParam := Min;
  Message.LParam := Max;
end;

procedure TFlatScrollbarTrack.DoSetPos(var Message: TMessage);
begin
  Position := Message.WParam;
end;

procedure TFlatScrollbarTrack.DoSetRange(var Message: TMessage);
begin
  Min := Message.WParam;
  Max := Message.LParam;
end;

procedure TFlatScrollbarTrack.DoKeyDown(var Message: TWMKeyDown);
var
  iPosition: Integer;
begin
  iPosition := Position;
  case Message.CharCode of
    VK_PRIOR: Dec(iPosition,LargeChange);
    VK_NEXT: Inc(iPosition,LargeChange);
    VK_UP: if FKind = sbVertical then Dec(iPosition,SmallChange);
    VK_DOWN: if FKind = sbVertical then Inc(iPosition,SmallChange);
    VK_LEFT: if FKind = sbHorizontal then Dec(iPosition,SmallChange);
    VK_RIGHT: if FKind = sbHorizontal then Inc(iPosition,SmallChange);
  end;
  Position := iPosition;
end;

{ TFlatScrollbarButton }

constructor TFlatScrollbarButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
end;

destructor TFlatScrollbarButton.Destroy;
begin
  inherited Destroy;
end;

procedure TFlatScrollbarButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseDown(Button,Shift,X,Y);
  FNewDown := True;
  FTimer := TTimer.Create(Self);
  FTimer.Interval := 10;
  FTimer.OnTimer := DoTimer;
  FTimer.Enabled := True;
end;

procedure TFlatScrollbarButton.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseMove(Shift,X,Y);
end;

procedure TFlatScrollbarButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseUp(Button,Shift,X,Y);
  FNewDown := False;
  FTimer.Enabled := False;
  FTimer.Free;
end;

procedure TFlatScrollbarButton.DoTimer(Sender: TObject);
begin
  if FNewDown = True then
  begin
    if Assigned(FOnDown) then FOnDown(Self);
    TFlatScrollbar(Parent).DoScroll;
  end;
end;

{ TFlatScrollbar }

constructor TFlatScrollbar.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  Width := 200;
  Height := 17;

  Color := ecLightKaki;

  FBtnOne := TFlatScrollbarButton.Create(Self);
  FBtnOne.Color := ecLightKaki;
  FBtnOne.ColorFocused := ecLightKaki;
  FBtnOne.ColorDown := ecLightKaki;
  FBtnOne.ColorBorder := ecLightKaki;
  FBtnOne.Glyph.LoadFromResourceName(hInstance,'THUMB_UP_ENABLED');
  FBtnOne.OnDown := BtnOneClick;
  InsertControl(FBtnOne);

  FBtnTwo := TFlatScrollbarButton.Create(Self);
  FBtnTwo.Color := ecLightKaki;
  FBtnTwo.ColorFocused := ecLightKaki;
  FBtnTwo.ColorDown := ecLightKaki;
  FBtnTwo.ColorBorder := ecLightKaki;
  FBtnTwo.Glyph.LoadFromResourceName(hInstance,'THUMB_DOWN_ENABLED');
  FBtnTwo.OnDown := BtnTwoClick;
  InsertControl(FBtnTwo);

  FTrack := TFlatScrollbarTrack.Create(Self);
  FTrack.Color := ecLightKaki;
  FTrack.SetBounds(0,0,Width,Height);
  InsertControl(FTrack);

  Kind := sbVertical;

  Min := 0;
  Max := 100;
  Position := 0;
  SmallChange := 1;
  LargeChange := 1;

  ButtonColor := ecScrollbar;
  ButtonFocusedColor := ecScrollbar;
  ButtonDownColor := ecScrollbar;
  ButtonBorderColor := ecScrollbar;
  ButtonHighlightColor := clWhite;
  ButtonShadowColor := clBlack;

  ThumbColor := ecScrollbarThumb;
  ThumbFocusedColor := ecScrollbarThumb;
  ThumbDownColor := ecScrollbarThumb;
  ThumbBorderColor := ecScrollbarThumb;
  ThumbHighlightColor := ecScrollbarThumb;
  ThumbShadowColor := ecScrollbarThumb;
end;

destructor TFlatScrollbar.Destroy;
begin
  FTrack.Free;
  FBtnOne.Free;
  FBtnTwo.Free;
  inherited Destroy;
end;

procedure TFlatScrollbar.SetSmallChange(Value: Integer);
begin
  if Value <> FSmallChange then
  begin
    FSmallChange := Value;
    FTrack.SmallChange := FSmallChange;
  end;
end;

procedure TFlatScrollbar.SetLargeChange(Value: Integer);
begin
  if Value <> FLargeChange then
  begin
    FLargeChange := Value;
    FTrack.LargeChange := FLargeChange;
  end;
end;

procedure TFlatScrollbar.SetMin(Value: Integer);
begin
  if Value <> FMin then
  begin
    FMin := Value;
    FTrack.Min := FMin;
  end;
end;

procedure TFlatScrollbar.SetMax(Value: Integer);
begin
  if Value <> FMax then
  begin
    FMax := Value;
    FTrack.Max := FMax;
  end;
end;

procedure TFlatScrollbar.SetPosition(Value: Integer);
begin
  FPosition := Value;
  if Position < Min then
  begin
    Position := Min;
  end;
  if Position > Max then
  begin
    Position := Max;
  end;
  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');