sscrollbar.pas

Alpha Controls 5.40,delphi上的alpha开发源码控件包。没有密码。5.40版的最新版。

          if Kind = sbHorizontal then begin
            if not Assigned(FCommonData.SkinManager) or not FCommonData.SkinManager.IsValidSkinIndex(IndexScrollBar1H) then Exit;
            PaintItemFast(IndexScrollBar1H, MaskScrollBar1H, BGScrollBar1H, BGHotScrollBar1H,
                          s_ScrollBar1H, lCi, True, LocalState, FBar1Rect, Point(Left, Top), FCommonData.FCacheBmp, SkinData.SkinManager);
          end
          else begin
            if not Assigned(FCommonData.SkinManager) or not FCommonData.SkinManager.IsValidSkinIndex(IndexScrollBar1V) then Exit;
            PaintItemFast(IndexScrollBar1V, MaskScrollBar1V, BGScrollBar1V, BGHotScrollBar1V,
                          s_ScrollBar1V, lCi, True, LocalState, FBar1Rect, Point(Left, Top), FCommonData.FCacheBmp, SkinData.SkinManager);
          end;
        end;
        Bar2Rect;
        if (HeightOf(FBar2Rect) > 0) and (WidthOf(FBar2Rect) > 0) then begin
          LocalState := Bar2State;
          if LocalState = 0 then LocalState := integer(BarIsHot);
          LocalState := LocalState * integer(Enabled);
          if Kind = sbHorizontal then begin
            PaintItemFast(IndexScrollBar2H, MaskScrollBar2H,
                          BGScrollBar2H, BGHotScrollBar2H,
                          s_ScrollBar2H, lCi, True, LocalState, FBar2Rect, Point(Left + FBar2Rect.Left, Top + FBar2Rect.Top), FCommonData.FCacheBmp, SkinData.SkinManager);
          end
          else begin
            PaintItemFast(IndexScrollBar2V, MaskScrollBar2V,
                          BGScrollBar2V, BGHotScrollBar2V,
                          s_ScrollBar2V, lCi, True, LocalState, FBar2Rect, Point(Left + FBar2Rect.Left, Top + FBar2Rect.Top), FCommonData.FCacheBmp, SkinData.SkinManager);
          end;
        end;
      end;
      BitBlt(bmp.Canvas.Handle, 0, 0, bmp.Width, bmp.Height, FCommonData.FCacheBmp.Canvas.Handle, 0, 0, SRCCOPY);

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

    //  if bmp <> FCommonData.FCacheBmp then BitBlt(bmp.Canvas.Handle, 0, 0, bmp.Width, bmp.Height, FCommonData.FCacheBmp.Canvas.Handle, 0, 0, SRCCOPY);

      if (LinkedControl = nil) or Enabled or not LinkedControl.Enabled then DrawSlider(bmp);

      if not Enabled then begin
        if (LinkedControl <> nil) then begin
          SendAMessage(LinkedControl, AC_GETCACHE);
          if GlobalCacheInfo.Ready then begin
            BmpDisabledKind(bmp, FDisabledKind, Parent, GlobalCacheInfo, Point(Left - LinkedControl.Left, Top - LinkedControl.Top));
          end
          else begin
            c.C := ColorToRGB(FCommonData.SkinManager.gd[FCommonData.SkinManager.ConstData.IndexScrollBar1H].Color);
            FadeBmp(bmp, Rect(0, 0, bmp.Width + 1, bmp.Height + 1), 60, c, 0, 0);
          end;
        end
        else begin
          lCI := GetParentCache(FCommonData);
          BmpDisabledKind(bmp, FDisabledKind, Parent, lCI, Point(Left, Top));
        end;
{        lCI := GetParentCache(FCommonData);
        if not lCI.Ready and (LinkedControl <> nil) and (LinkedControl <> Parent) then begin
          c.C := ColorToRGB(gd[ConstData.IndexScrollBar1H].Color);
          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, bmp.Width, bmp.Height, bmp.Canvas.Handle, 0, 0, SRCCOPY);
    end;
    if not Enabled and Assigned(bmp) then FreeAndNil(bmp);
  finally
    RestoreDC(DC, SavedDC);
    if MsgDC = 0 then ReleaseDC(Handle, DC);
    EndPaint(Handle, PS);
  end;
end;

procedure TsScrollBar.Preparetimer;
begin
  if Assigned(Timer) then FreeAndNil(Timer);
  SetCapture(Handle);
  Timer := TTimer.Create(Self);
  Timer.OnTimer := OnTimer;
  Timer.Interval := 50; // {500; KJS} more smooth scrolling
  Timer.Enabled := True;
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 FSI.nPage = 0 then
    Result := MinSize
  else
    Result := math.max(MinSize, Round(FSI.nPage * (WorkSize / (FSI.nMax - Math.Max(Integer(FSI.nPage) - 1,0) + integer(FSI.nPage) - FSI.nMin))));
end;

procedure TsScrollBar.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
  if not DrawingForbidden then DefaultHandler(Message);
end;

procedure TsScrollBar.WndProc(var Message: TMessage);
var
  OldPos : integer;
begin
{$IFDEF LOGGED}
  AddToLog(Message);
{$ENDIF}
  if (Message.Msg = SM_ALPHACMD) and not (csDestroying in ComponentState) {v4.41} then case Message.WParamHi of
    AC_CTRLHANDLED : begin Message.LParam := 1; Exit end; // AlphaSkins supported
    AC_GETAPPLICATION : begin Message.Result := longint(Application); Exit end;
    AC_REMOVESKIN : if LongWord(Message.LParam) = LongWord(SkinData.SkinManager) then begin
      CommonWndProc(Message, FCommonData);
      if not SkinnedRecreate then begin
        OldPos := Position;
        RecreateWnd;
        Position := OldPos;
      end;
      exit
    end;
    AC_SETNEWSKIN : if (LongWord(Message.LParam) = LongWord(SkinData.SkinManager)) then begin
      CommonWndProc(Message, FCommonData);
      exit
    end;
    AC_REFRESH : if (LongWord(Message.LParam) = LongWord(SkinData.SkinManager)) then begin
      CommonWndProc(Message, FCommonData);
      FCommonData.BGChanged := True;
      if not SkinnedRecreate then begin
        SkinnedRecreate := True;
        OldPos := Position;
        RecreateWnd;
        Position := OldPos;
        SkinnedRecreate := False;
      end;
      exit
    end;
    AC_ENDPARENTUPDATE : {if FCommonData.Updating then} begin
      FCommonData.Updating := False;
      Repaint;
      Exit
    end
  end;
  if Assigned(FCommonData) then begin
    case Message.Msg of
      WM_PRINT : if (DefaultManager <> nil) and DefaultManager.Active then begin
        SendMessage(Handle, WM_PAINT, Message.WParam, Message.LParam);
        Perform(WM_NCPAINT, Message.WParam, Message.LParam);
        Exit;
      end;
      WM_PAINT, WM_NCHITTEST {v4.53} : if MustBeRecreated then begin // Control must be recreated for the skinned mode using without std blinking
        MustBeRecreated := False;
        SkinnedRecreate := True;
        OldPos := Position;
        RecreateWnd;
        Position := OldPos;
        SkinnedRecreate := False;
      end;
    end;
    CommonWndProc(Message, FCommonData);
  end;
  if Assigned(FCommonData) and Skinned(Self) then
    case Message.Msg of
//      WM_NCPAINT : Exit;
      SBM_SETSCROLLINFO :
        begin
          with PScrollInfo(Message.LParam)^ do begin
            if Boolean(fMask and SIF_PAGE) and (FSI.nPage <> nPage) then begin
              FSI.nPage := nPage;
              RepaintNeeded := LongBool(Message.WParam);
            end;
            if Boolean(fMask and SIF_POS) and (FSI.nPos <> nPos) then begin
              FSI.nPos := nPos;
              RepaintNeeded := LongBool(Message.WParam);
            end;
            if Boolean(fMask and SIF_RANGE) and ((FSI.nMin <> nMin) or (FSI.nMax <> nMax)) then begin
              if (nMax - nMin) < 0 then begin
                FSI.nMin := 0;
                FSI.nMax := 0;
                RepaintNeeded := LongBool(Message.WParam);
              end else begin
                FSI.nMin := nMin;
                FSI.nMax := nMax;
                RepaintNeeded := LongBool(Message.WParam);
              end;
            end;
            if integer(FSI.nPage) < 0 then
              FSI.nPage := 0
            else if integer(FSI.nPage) > (FSI.nMax - FSI.nMin + 1) then
              FSI.nPage := (FSI.nMax - FSI.nMin + 1);
            if FSI.nPos < FSI.nMin then
              FSI.nPos := FSI.nMin
            else if FSI.nPos > (FSI.nMax - Math.Max(Integer(FSI.nPage) - 1, 0)) then
              FSI.nPos := (FSI.nMax - Math.Max(Integer(FSI.nPage) - 1, 0));

            if (ScrollCode <> SB_THUMBTRACK) then FCurrPos := FSI.nPos;

          end;
          UpdateBar;
        end;
      SBM_GETSCROLLINFO :
        begin
          with PScrollInfo(Message.LParam)^ do begin
            if Boolean(fMask and SIF_PAGE) then begin
              nPage := FSI.nPage;
            end;
            if Boolean(fMask and SIF_POS) then begin
              nPos := FSI.nPos;
            end;
            if Boolean(fMask and SIF_TRACKPOS) and (cbSize = SizeOf(TScrollInfo)) then begin
              nTrackPos := FSI.nTrackPos;
            end;
            if Boolean(fMask and SIF_RANGE) then begin
              nMin := FSI.nMin;
              nMax := FSI.nMax;
            end;
          end;
        end;
    end;
  inherited WndProc(Message);
end;

procedure TsScrollBar.DrawSlider(b: TBitmap);
var
  R : TRect;
  i1 : integer;
  TmpBmp : TBitmap;
begin
  R := SliderRect;
  if (Kind = sbVertical) then begin
    if HeightOf(R) > Height - HeightOf(FBtn1Rect) - HeightOf(FBtn2Rect) then Exit
  end
  else if WidthOf(R) > Width - WidthOf(FBtn1Rect) - WidthOf(FBtn2Rect) then Exit;

  TmpBmp := TBitmap.Create;
  TmpBmp.Width := WidthOf(R);
  TmpBmp.Height := HeightOf(R);
  TmpBmp.PixelFormat := pf24bit;
  BitBlt(TmpBmp.Canvas.Handle, 0, 0, TmpBmp.Width, TmpBmp.Height, FCommonData.FCacheBmp.Canvas.Handle, R.Left, R.Top, SRCCOPY);
  Ci.Bmp := FCommonData.FCacheBmp;
  Ci.X := 0;
  Ci.Y := 0;
  with FCommonData.SkinManager.ConstData do begin
    if Kind = sbHorizontal then begin
      PaintItemFast(IndexSliderHorz, MaskSliderHorz, ScrollSliderBGHorz, ScrollSliderBGHotHorz, s_ScrollSliderH,
          Ci, True, SliderState, Rect(0, 0, TmpBmp.Width, TmpBmp.Height), R.TopLeft, TmpBmp, SkinData.SkinManager);
      i1 := MaskSliderGlyphHorz;
    end
    else begin
      PaintItemFast(IndexSliderVert, MaskSliderVert, ScrollSliderBGVert, ScrollSliderBGHotVert, s_ScrollSliderV,
          Ci, True, SliderState, Rect(0, 0, TmpBmp.Width, TmpBmp.Height), R.TopLeft, TmpBmp, SkinData.SkinManager);
      i1 := MaskSliderGlyphVert;
    end;
  end;
  BitBlt(b.Canvas.Handle, R.Left, R.Top, TmpBmp.Width, TmpBmp.Height, TmpBmp.Canvas.Handle, 0, 0, SRCCOPY);
  FreeAndNil(TmpBmp);
  Ci.Bmp := FCommonData.FCacheBmp;

  if Assigned(FCommonData.SkinManager) and FCommonData.SkinManager.IsValidImgIndex(i1) then
    with FCommonData.SkinManager do begin
    if FCommonData.SkinManager.ma[i1].Bmp = nil then begin
      p.x := FSliderRect.Left + (WidthOf(FSliderRect) - WidthOf(ma[i1].R) div ma[i1].ImageCount) div 2 + integer(SliderState = 2);
      p.y := FSliderRect.Top + (HeightOf(FSliderRect) - HeightOf(ma[i1].R) div (1 + ma[i1].MaskType)) div 2 + integer(SliderState = 2);
    end
    else if (((Kind = sbVertical) and (ma[i1].Bmp.Height div 2 < HeightOf(FSliderRect))) or
         ((Kind = sbHorizontal) and (ma[i1].Bmp.Width div 2 < WidthOf(FSliderRect)))) then begin
      p.x := FSliderRect.Left + (WidthOf(FSliderRect) - ma[i1].Bmp.Width div 3) div 2 + integer(SliderState = 2);
      p.y := FSliderRect.Top + (HeightOf(FSliderRect) - ma[i1].Bmp.Height div 2) div 2 + integer(SliderState = 2);
    end;
    DrawSkinGlyph(b, p, SliderState, 1, ma[i1]);
  end;
end;

procedure TsScrollBar.WMNCHitTest(var Message: TWMNCHitTest);
var
  i : integer;
begin
  if Skinned(Self) and Enabled and (not (csDesigning in ComponentState) {or AlwaysLive}) then begin
    if not ControlIsReady(Self) then Exit;
    if PtInRect(SliderRect, CoordToPoint(SmallPointToPoint(Message.Pos))) or (SliderState = 2) then begin
      if SliderState <> 2 then SliderState := 1 else begin
        i := CoordToPosition(CoordToPoint(Point(Message.Pos.X, Message.Pos.Y))) - MouseOffset;
        if FCurrPos <> i then begin
          DrawingForbidden := True;
          SetPos(i);
        end;
      end;
    end
    else
    if PtInRect(Btn1Rect, CoordToPoint(SmallPointToPoint(Message.Pos))) then begin
      if Btn1State <> 2 then Btn1State := 1;
    end
    else if PtInRect(Btn2Rect, CoordToPoint(SmallPointToPoint(Message.Pos))) then begin
      if Btn2State <> 2 then Btn2State := 1;
    end
    else if (SliderState = 2) then begin
      i := CoordToPosition(CoordToPoint(SmallPointToPoint(Message.Pos)));
      if FCurrPos <> i then begin
        DrawingForbidden := True;
        SetPos(i);
      end;
    end
    else begin
      SliderState := 0;
      Btn1State := 0;
      Btn2State := 0;
    end;
    if Self <> nil then UpdateBar;
  end;
  inherited;
end;

procedure TsScrollBar.OnBtnTimer(Sender: TObject);
begin
  if not Assigned(Timer) or (csDestroying in Timer.ComponentState) then Exit;
  if Btn1State = 2 then begin
    IncPos(-1);
  end
  else
  if Btn2State = 2 then begin
    IncPos(1);
  end
  else begin
    if Assigned(Timer) then FreeAndNil(Timer);
  end;
  if assigned(Timer) and (Timer.Interval > 50) then Timer.Interval := 50;        //KJS
end;