sscrollbox.pas

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

    inc(VertOffset, OldValue - VSBar.Position);
    SendMessage(Handle, WM_VSCROLL, MakeWParam(SB_THUMBPOSITION, VSBar.Position), 0);
    if Assigned(VSBar) then begin
      VSBar.DrawingForbidden := False;
    end else Exit;
    Scrolling := False;
    CommonData.BgChanged := False;
    if not VSBar.DontChange then begin
      Repaint;
    end;
  end;
end;

procedure TsScrollBox.Paint;
begin
  if not ControlIsReady(Self) or Scrolling then Exit;
  if Assigned(FCommonData) and FCommonData.BGChanged then begin
    PrepareCache;
  end;
  BitBlt(FCanvas.Handle, 0, 0, Width, Height, FCommonData.FCacheBmp.Canvas.Handle, 0, 0, SRCCOPY);
  RepaintsControls(Self, True);
  PaintControls(Canvas.Handle, nil);
  RefreshScrolls;
end;

{
procedure TsScrollBox.PaintWindow(DC: HDC);
var
  PS : TPaintStruct;
begin
  // Design - time drawing
  if IsValidSkinindex(FCommonData.SkinIndex) then begin
    FCanvas.Lock;
    try
      if DC = 0 then DC := BeginPaint(Handle, PS);
      FCanvas.Handle := DC;
      try
        Paint;
      finally
        FCanvas.Handle := 0;
        EndPaint(Handle, PS);
      end;
    finally
      FCanvas.Unlock;
    end;
  end
  else begin
    inherited PaintWindow(DC);
  end;
end;
}
procedure TsScrollBox.PrepareCache;
var
  CI : TCacheInfo;
begin
  try
    FCommonData.InitCacheBmp;
    CI.Ready := False;
    CI := GetParentCache(FCommonData);

    if FCommonData.RegionChanged then begin
      FCommonData.FRegion := 0;
      FCommonData.FRegion := CreateRectRgn(0,
                              0,
                              Width,
                              Height);
    end;
    PaintControl(FCommonData.SkinIndex, FCommonData.BorderIndex,
                 FCommonData.SkinSection, Ci,
                 False, 0,
                 Point(Left, Top),
                 FCommonData.FCacheBmp, FCommonData.FRegion
                );
    if FCommonData.RegionChanged then begin
      SetWindowRgn(Handle, FCommonData.FRegion, True);
      FCommonData.RegionChanged := False;
    end;
    FCommonData.BGChanged := False;
  except
    Alert('TsScrollBox.PrepareCache error');
  end;
end;

procedure TsScrollBox.RefreshScrolls;
var
  vsi, hsi : TsScrollInfo;
begin
  if csDestroying in ComponentState then Exit;
try
  if not ControlIsReady(Self) or not(HandleAllocated) then Exit;

  vsi := GetVScrollInfo;
  hsi := GetHScrollInfo;

  if not sSkinData.Active or not Visible then begin
    if Grip <> nil then begin
        // ! Exception arises if called in WndProc... Serge
        if not (csDesigning in ComponentState) then begin
          Grip.Visible := False;
        end
        else begin
          if Assigned(Grip) then FreeAndNil(Grip);
        end;
    end;
    ClearOffset(sbVertical);
    ClearOffset(sbHorizontal);
    Exit;
  end
  else begin
    if not vsi.Visible then ClearOffset(sbVertical);
    if not hsi.Visible then ClearOffset(sbHorizontal);
  end;

  // Prepare vertical scrollbar
  if vsi.Visible then begin
    if (VSBar = nil) then begin
      VSBar := TsScrollBar.Create(Self);
      VSBar.LinkedControl := Self;
      VSBar.OnChange := OnVSBChange;
      VSBar.DrawingForbidden := True;
      VSBar.TabStop := False;
      VSBar.Kind := sbVertical;
      VSBar.Width := WidthOf(vsi.Rect);
      VSBar.Parent := Parent;
      VSBar.Smooth := VertScrollBar.Smooth;
      BringToFront;
      VSBar.Visible := True;
      VSBar.BringToFront;
    end
    else begin
      VSBar.Visible := True;
      VSBar.BringtoFront;
    end;

    if Assigned(VSBar) then begin
      ControlIsReady(VSBar);
      VSBar.DrawingForbidden := True;
      VSBar.Max := vsi.Max;
      VSBar.SmallChange := VertScrollBar.Increment;
      VSBar.Min := 0;
      VSBar.PageSize := vsi.Page;
      VSBar.LargeChange := 80;
      VSBar.DrawingForbidden := False;
      VSBar.SetBounds(vsi.Rect.Left, vsi.Rect.Top, WidthOf(vsi.Rect), HeightOf(vsi.Rect));
    end;
  end else if Assigned(VSBar) then begin
    ClearOffset(sbVertical);
  end;

  // Prepare horizontal scrollbar
  if hsi.Visible then begin
    if (HSBar = nil) then begin
      if not Assigned(VSBar) then BringToFront;
      HSBar := TsScrollBar.Create(Self);
      HSBar.LinkedControl := Self;
      HSBar.OnChange := OnHSBChange;
      HSBar.DrawingForbidden := True;
      HSBar.Visible := True;
      HSBar.TabStop := False;
      HSBar.Kind := sbHorizontal;
      HSBar.Height := HeightOf(hsi.Rect);
      HSBar.Parent := Parent;
      HSBar.Smooth := HorzScrollBar.Smooth;
    end
    else begin
      HSBar.Visible := True;
      HSBar.BringtoFront;
    end;

    if Assigned(HSBar) then begin
      ControlIsReady(HSBar);
      HSBar.DrawingForbidden := True;
      HSBar.Max := hsi.Max;
      HSBar.SmallChange := HorzScrollBar.Increment;
      HSBar.Min := 0;
      HSBar.PageSize := hsi.Page;
      HSBar.LargeChange := 80;
      HSBar.DrawingForbidden := False;
      HSBar.SetBounds(hsi.Rect.Left, hsi.Rect.Top, WidthOf(hsi.Rect), HeightOf(hsi.Rect));
    end;
  end else if Assigned(HSBar) then begin
    ClearOffset(sbHorizontal);
  end;

  if vsi.Visible and hsi.Visible then begin
    if Grip = nil then begin
      Grip := TsGrip.Create(Self);
      Grip.LinkedControl := Self;
      Grip.Parent := Parent;
      Grip.Name := 'GripFor' + Name;
    end
    else begin
      Grip.Visible := True;
      Grip.BringToFront;
    end;
    if Grip <> nil then begin
      Grip.SetBounds(VSBar.Left + 1, HSBar.Top + 1, VSBar.Width - 1, HSBar.Height - 1);
    end;
  end
  else begin
    if Grip <> nil then begin
        // ! Exception arises if called in WndProc... Serge
        if not (csDesigning in ComponentState) then begin
          Grip.Visible := False;
        end
        else begin
          if Assigned(Grip) then FreeAndNil(Grip);
        end;
    end;
  end;
except
//alert('Error in TsScrollBox.RefreshScrolls');
end;
end;

procedure TsScrollBox.SetBorderStyle(const Value: TBorderStyle);
begin
  if Value <> FBorderStyle then begin
    FBorderStyle := Value;
    RecreateWnd;
  end;
end;

procedure TsScrollBox.WMMouseWheel(var Message: TMessage);
begin
  inherited;
  RefreshScrolls;
end;

procedure TsScrollBox.WMPaint(var Message: TWMPaint);
var
  DC, SavedDC : hdc;
  PS : TPaintStruct;
begin
  if IsValidSkinindex(FCommonData.SkinIndex) then begin
    Message.Result := 1;
    if Scrolling then Exit;
    DC := Message.DC;
    if DC = 0 then DC := BeginPaint(Handle, PS);
    SavedDC := SaveDC(DC);
    Canvas.Lock;
    Canvas.Handle := DC;
    try;
      Paint;
      Canvas.Handle := 0;
    finally
      Canvas.Unlock;
      RestoreDC(DC, SavedDC);
    end;
  end else inherited;
end;

procedure TsScrollBox.WndProc(var Message: TMessage);
begin
  if not ControlIsReady(Self) then inherited
  else begin
    if Assigned(FCommonData) and FCommonData.Skinned then begin
      case Message.Msg of
        CM_VISIBLECHANGED, WM_SIZE, CM_ENABLEDCHANGED, WM_MOUSEWHEEL, WM_MOVE : if FCommonData.Skinned then begin
          FCommonData.BGChanged := True;
          Repaint;
          if not Scrolling then RefreshScrolls;
        end;
        WM_SETFOCUS, CM_ENTER, WM_KILLFOCUS, CM_EXIT: if FCommonData.Skinned then begin
          FCommonData.FFocused := (Message.Msg = CM_ENTER) or (Message.Msg = WM_SETFOCUS);
          FCommonData.FMouseAbove := False;
          FCommonData.BGChanged := True;
          Repaint;
          if not Scrolling then RefreshScrolls;
        end;
        WM_NCPAINT : begin
          Message.Result := 1;
        end;
        WM_ERASEBKGND : begin
          Message.Result := 1;
        end;
        SM_GETCACHE : begin
          GlobalCacheInfo.Bmp := FCommonData.FCacheBmp;
          GlobalCacheInfo.X := 0;
          GlobalCacheInfo.Y := 0;
          GlobalCacheInfo.Ready := True;
          Message.Result := 1;
        end;
        SM_REMOVESKIN : if not (csDestroying in ComponentState) then begin
          FCommonData.BorderIndex := -1;
          FCommonData.SkinIndex := -1;
          FCommonData.RegionChanged := True;
          RefreshScrolls;
          RecreateWnd;
        end;
      end;
    end;
    if Message.Result <> 1 then begin
      if Assigned(FCommonData) then FCommonData.WndProc(Message);
      inherited;
    end;
    case Message.Msg of
      SM_REMOVESKIN : if not (csDestroying in ComponentState) then begin
        FCommonData.BorderIndex := -1;
        FCommonData.SkinIndex := -1;
        FCommonData.RegionChanged := True;
        RefreshScrolls;
        RecreateWnd;
      end;
    end;
  end;
end;

end.