sscrollbar.pas

AlphaControls是一个Delphi标准控件的集合

  end;
end;

procedure TsScrollBar.DrawBtnRight(b: TBitmap);
begin
  Ci.Bmp := b;
  PaintItem(Btn2SkinIndex, ArrowRight, Ci, True,
    Btn2State,
    Btn2DRect,
    Point(Btn2Rect.Left, Btn2Rect.Top), b);
  Ci.Bmp := FCommonData.FCacheBmp;

  i1 := GetMaskIndex(FBtn2SkinIndex, ArrowRight, ItemGlyph);
  if IsValidImgIndex(i1) and (ma[i1].Bmp.Width div 3 < WidthOf(FBtn1Rect)) then begin
    p.x := FBtn2Rect.Left + (WidthOf(FBtn2Rect) - ma[i1].Bmp.Width div 3) div 2;// + integer(Btn2State = 2);
    p.y := FBtn2Rect.Top + (HeightOf(FBtn2Rect) - ma[i1].Bmp.Height div 2) div 2;// + integer(Btn2State = 2);
    if (p.x < 0) or (p.y < 0) then Exit; 
    PaintRasterGlyph(b, ma[i1].Bmp,
            p, Btn2State, ma[i1].TransparentColor);
  end;
end;

procedure TsScrollBar.DrawBtnTop(b: TBitmap);
begin
  Ci.Bmp := b;
  PaintItem(Btn1SkinIndex, ArrowTop, Ci, True,
    Btn1State,
    Btn1DRect,
    Point(Btn1Rect.Left, Btn1Rect.Top), b);
  Ci.Bmp := FCommonData.FCacheBmp;

  i1 := GetMaskIndex(FBtn1SkinIndex, Arrowtop, ItemGlyph);
  if IsValidImgIndex(i1) and (ma[i1].Bmp.Height div 2 < HeightOf(FBtn1Rect)) then begin
    p.x := FBtn1Rect.Left + (WidthOf(FBtn1Rect) - ma[i1].Bmp.Width div 3) div 2;// + integer(Btn1State = 2);
    p.y := FBtn1Rect.Top + (HeightOf(FBtn1Rect) - ma[i1].Bmp.Height div 2) div 2;// + integer(Btn1State = 2);
    if (p.x < 0) or (p.y < 0) then Exit;
    PaintRasterGlyph(b, ma[i1].Bmp,
            p, Btn1State, ma[i1].TransparentColor);
  end;
end;

function TsScrollBar.FirstPoint: integer;
begin
  if Kind = sbHorizontal then begin
    Result := GetSystemMetrics(SM_CXHSCROLL);
  end
  else begin
    Result := GetSystemMetrics(SM_CYVSCROLL);
  end;
end;

procedure TsScrollBar.Loaded;
begin
  inherited;
  FCommonData.Loaded;
end;

procedure TsScrollBar.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  i : integer;
begin
  if not ControlIsReady(Self) then Exit;
  if not Skinable or not Enabled or not (Button = mbLeft) then begin inherited; end
  else begin
    MouseOffset := 0;
{
    if Assigned(ParentSStyle) and (ParentSStyle.FOwner is TWinControl) then begin
      if not TWinControl(ParentSStyle.FOwner).Focused then TWinControl(ParentSStyle.FOwner).SetFocus;
    end
    else
}
    if CanFocus then SetFocus;
    // If Button1 pressed...
    if PtInRect(Btn1Rect, Point(x,y)) then begin
      if Btn1State <> 2 then begin
        Btn1State := 2;
        if Position <> Min then begin
          DrawingForbidden := True;
          Position := FPosition - SmallChange;
          PrepareBtnTimer;
        end;
      end;
    end
    // If Button2 pressed...
    else if PtInRect(Btn2Rect, Point(x,y)) then begin
      if Btn2State <> 2 then begin
        Btn2State := 2;
        if Position <> Max then begin
          DrawingForbidden := True;
          Position := FPosition + SmallChange;
          PrepareBtnTimer;
        end;
      end;
    end
    // If slider pressed...
    else if PtInRect(SliderRect, Point(x,y)) then begin
      InitDontChange;
      if SliderState <> 2 then begin
        i := CoordToPosition(Point(x, y));
        MouseOffset := i - Position;
        SliderState := 2;
        PrepareTimer;
      end;
    end
    else begin
      if PtInRect(Bar1Rect, Point(x,y)) then begin
        if Bar1State <> 2 then begin
          Bar1State := 2;
          Bar2State := integer(BarIsHot);
          DrawingForbidden := True;
          Position := FPosition - LargeChange;
          PrepareBarTimer;
        end;
      end
      else begin
        if Bar2State <> 2 then begin
          Bar1State := integer(BarIsHot);
          Bar2State := 2;
          DrawingForbidden := True;
          Position := FPosition + LargeChange;
          PrepareBarTimer;
        end;
      end;
    end;
    UpdateBar;
  end;
end;

procedure TsScrollBar.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if not ControlIsReady(Self) then Exit;
  if not skinable or not Enabled then begin inherited; end
  else begin
    if Assigned(Timer) then begin
      Timer.Enabled := False;
      if Assigned(Timer) then FreeAndNil(Timer);
    end;
    if PtInRect(SliderRect, Point(X, Y)) or (SliderState = 2) then begin
      Bar1State := integer(BarIsHot);
      Bar2State := Bar1State;
      if SliderState = 2 then begin
        DrawingForbidden := True;
        Position := CoordToPosition(Point(X, Y)) - MouseOffset;
        if PtInRect(SliderRect, Point(X, Y)) then begin
          SliderState := 1;
        end
        else begin
          SliderState := 0;
        end;
        ClearDontChange;
{
        if PtInRect(SliderRect, Point(X, Y)) then begin
          SliderState := 1;
        end
        else begin
          SliderState := 0;
        end;
}        
      end
      else
    end
    else
    if PtInRect(Btn1Rect, Point(X, Y)) and (Btn1State = 2) then begin
      Btn1State := 1;
    end
    else if PtInRect(Btn2Rect, Point(X, Y)) and (Btn2State = 2) then begin
      Btn2State := 1;
    end
    else
    if (Bar1State = 2) then begin
      Bar1State := integer(BarIsHot);
    end
    else
    if (Bar2State = 2) then begin
      Bar2State := integer(BarIsHot);
    end;
    UpdateBar;
    ReleaseCapture;
    inherited;
  end;
end;

function TsScrollBar.NotRightToLeft: Boolean;
begin
  Result := (not IsRightToLeft) or (FKind = sbVertical);
end;

procedure TsScrollBar.OnTimer(Sender: TObject);
begin
  if not Assigned(Timer) or not ControlIsReady(Self) or (csDestroying in Timer.ComponentState) or FCommonData.FMouseAbove then Exit;
  if (SliderState = 2) then begin
    Position := CoordToPosition(ScreenToClient(Mouse.CursorPos)) - MouseOffset;
  end;
  SetCapture(Handle);
end;

procedure TsScrollBar.Paint;
var
  DC, SavedDC : hdc;
  b : TBitmap;
  lCI : TCacheInfo;
  LocalState : integer;
  c : TsColor;
  SkinIndex : integer;
begin
  SkinIndex := -1;
  if DrawingForbidden or not ControlIsReady(Self) or (csCreating in Controlstate) then Exit;

  RepaintNeeded := False;

  b := TBitmap.Create;
  b.Width := Width;
  b.Height := Height;
  b.PixelFormat := pf24bit;

  try
  if FCommonData.FCacheBmp.Width <> Width then FCommonData.FCacheBmp.Width := Width;
  if FCommonData.FCacheBmp.Height <> Height then FCommonData.FCacheBmp.Height := Height;

{ 28.11.2003 Serge
  if ParentSStyle <> nil then begin
    lCI.Bmp := ParentSStyle.FCacheBmp;
    lCI.Ready := False;
    lCI.X := 0;
    lCI.Y := 0;
  end
}
  if LinkedControl <> nil then begin
    GlobalCacheInfo.Ready := False;
    if LinkedControl is TWinControl then begin
      SendMessage(TWinControl(LinkedControl).Handle, SM_GETCACHE, 0, 0);
    end
    else begin
      LinkedControl.Perform(SM_GETCACHE, 0, 0);
    end;
    lCI := GlobalCacheInfo;
    if not (LinkedControl is TCustomForm) then begin
      dec(lCI.X, LinkedControl.Left);
      dec(lCI.Y, LinkedControl.Top);
    end;
  end
  else begin
    lCI := GetParentCache(FCommonData);
  end;

  if (HeightOf(Bar1Rect) > 0) and (WidthOf(Bar1Rect) > 0) then begin
    LocalState := Bar1State;
    if LocalState = 0 then LocalState := integer(BarIsHot);
    LocalState := LocalState * integer(Enabled);
    if Kind = sbHorizontal then begin
      SkinIndex := GetSkinIndex(ScrollBar1 + 'H');
      PaintItem(SkinIndex, ScrollBar1 + 'H', lCi, True, LocalState, Bar1Rect, Point(Left, Top), FCommonData.FCacheBmp);
    end
    else begin
      SkinIndex := GetSkinIndex(ScrollBar1 + 'V');
      PaintItem(SkinIndex, ScrollBar1 + 'V', lCi, True, LocalState, Bar1Rect, Point(Left, Top), FCommonData.FCacheBmp);
    end;
  end;

  if (HeightOf(Bar2Rect) > 0) and (WidthOf(Bar2Rect) > 0) then begin
    LocalState := Bar2State;
    if LocalState = 0 then LocalState := integer(BarIsHot);
    LocalState := LocalState * integer(Enabled);
    Bar2Rect;
    if Kind = sbHorizontal then begin
      PaintItem(GetSkinIndex(ScrollBar2 + 'H'), ScrollBar2 + 'H', lCi, True, LocalState, Bar2Rect, Point(Left + Bar2Rect.Left, Top + Bar2Rect.Top), FCommonData.FCacheBmp);
    end
    else begin
      PaintItem(GetSkinIndex(ScrollBar2 + 'V'), ScrollBar2 + 'V', lCi, True, LocalState, Bar2Rect, Point(Left + Bar2Rect.Left, Top + Bar2Rect.Top), FCommonData.FCacheBmp);
    end;
  end;

  BitBlt(b.Canvas.Handle, 0, 0, b.Width, b.Height, FCommonData.FCacheBmp.Canvas.Handle, 0, 0, SRCCOPY);


  if Kind = sbHorizontal then begin
    DrawBtnLeft(b);
    DrawBtnRight(b);
  end else begin
    DrawBtnTop(b);
    DrawBtnBottom(b);
  end;

  if (LinkedControl = nil) or Enabled or not LinkedControl.Enabled then begin
    DrawSlider(b)
  end;

  except
  end;

  DC := GetWindowDC(Handle);
  SavedDC := SaveDC(DC);
  try

    if not Enabled then begin
      lCI := GetParentCache(FCommonData);
      if (LinkedControl <> nil) and (LinkedControl <> Parent)
        then begin
          c.C := ColorToRGB(gd[SkinIndex].PaintingColor);
          FadeBmp(b, Rect(0, 0, b.Width + 1, b.Height + 1), 60, c, 0, 0);
        end
        else BmpDisabledKind(b, FDisabledKind, Parent, lCI, Point(Left, Top));
    end;

    BitBlt(DC, 0, 0, b.Width, b.Height, b.Canvas.Handle, 0, 0, SRCCOPY);
  finally
    RestoreDC(DC, SavedDC);
    ReleaseDC(Handle, DC);
    if Assigned(b) then FreeAndNil(b);
  end;
end;

procedure TsScrollBar.Preparetimer;
begin
  if Assigned(Timer) then FreeAndNil(Timer);
  Timer := TTimer.Create(Self);
  Timer.OnTimer := OnTimer;
  Timer.Interval := 100;
  Timer.Enabled := True;
  SetCapture(Handle);
end;

procedure TsScrollBar.Scroll(ScrollCode: TScrollCode; var ScrollPos: Integer);
begin
  if Assigned(FOnScroll) then FOnScroll(Self, ScrollCode, ScrollPos);
end;

function TsScrollBar.ScrollSliderIndex: integer;
begin
  FScrollSliderIndex := GetSkinIndex(SliderSectionName);
  Result := FScrollSliderIndex;
end;

procedure TsScrollBar.SetKind(Value: TScrollBarKind);
begin
  if FKind <> Value then begin
    FKind := Value;
    if not (csLoading in ComponentState) then SetBounds(Left, Top, Height, Width);
    RecreateWnd;
  end;
end;

procedure TsScrollBar.SetMax(Value: Integer);
begin
  SetParams(FPosition, FMin, Value);
  Invalidate;
end;

procedure TsScrollBar.SetMin(Value: Integer);
begin
  SetParams(FPosition, Value, FMax);
  Invalidate;
end;

procedure TsScrollBar.SetPageSize(Value: Integer);
var
  ScrollInfo: TScrollInfo;
begin
//  if (FPageSize = Value) or (FPageSize > FMax) or (Value > FMax) then exit;
  if (Value < 0) then exit;
  FPageSize := Value;
  ScrollInfo.cbSize := SizeOf(ScrollInfo);
  ScrollInfo.nPage := Value;
  ScrollInfo.fMask := SIF_PAGE;
  if HandleAllocated then
    SetScrollInfo(Handle, SB_CTL, ScrollInfo, True);
  Invalidate;
end;

procedure TsScrollBar.SetParams(APosition, AMin, AMax: Integer);
var
  OldValue : integer;
begin
  OldValue := FPosition;
  if (AMax <= AMin) then begin
    ShowError(SScrollBarRange + #10#13 + 'Max = ' + IntToStr(AMAx))
  end;
  if APosition < AMin then APosition := AMin;
  if APosition > AMax then APosition := AMax;
  if (FMin <> AMin) or (FMax <> AMax) then begin
    FMin := AMin;
    FMax := AMax;
    if HandleAllocated then SetScrollRange(Handle, SB_CTL, AMin, AMax, FPosition = APosition);
  end;
  if FPosition <> APosition then begin
    FPosition := APosition;
    if HandleAllocated then begin
      if NotRightToLeft then begin
        SetScrollPos(Handle, SB_CTL, FPosition, True)
      end
      else begin
        SetScrollPos(Handle, SB_CTL, FMax - FPosition, True);
      end;
    end;
//    Enabled := True;?
    if Skinable then begin
      RepaintNeeded := True;
      Change(OldValue);
    end;
  end;
end;

procedure TsScrollBar.SetPosition(Value: Integer);
begin
  if (csCreating in ControlState) or (csDestroying in ComponentState) then Exit;
  if (Value = FPosition) or
       ((FPosition = FMin) and (Value < FMin)) or
         ((FPosition = FMax) and (Value > FMax - 1))
           then Exit;
  SetParams(Value, FMin, FMax);
  UpdateBar;
end;

function TsScrollBar.SliderRect: TRect;
begin
  if Kind = sbHorizontal then begin
    FSliderRect.Left := PositionToCoord - SliderSize div 2;
    FSliderRect.Top := 0;
    FSliderRect.Right := FSliderRect.Left + SliderSize;
    FSliderRect.Bottom := Height;
  end
  else begin
    FSliderRect.Left := 0;
    FSliderRect.Top := PositionToCoord - SliderSize div 2;
    FSliderRect.Right := Width;
    FSliderRect.Bottom := FSliderRect.Top + SliderSize;
  end;
  Result := FSliderRect;
end;

function TsScrollBar.SliderSize : integer;
const
  MinSize = 14;
begin
  if PageSize = 0 then begin
    Result := MinSize;
  end
  else begin
    Result := Round(math.max(MinSize, PageSize * (WorkSize / (Max + PageSize - Min))));
  end;
end;

procedure TsScrollBar.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
  if Skinable then begin
    if OnTop then BringToFront;
    Message.Result := 1;
  end
  else inherited;
end;

procedure TsScrollBar.WndProc(var Message: TMessage);
begin
  if Assigned(FCommonData) then FCommonData.WndProc(Message);
  inherited WndProc(Message);
  case Message.Msg of