Как заставить полосы прокрутки хорошо играть в пользовательском элементе управления?

Question

Моя проблема связана с настраиваемым элементом управления, который я пытаюсь разработать, и я не могу понять, как правильно реализовать полосы прокрутки. В основных моментах я остановлюсь на том, что я пытаюсь сделать, чтобы облегчить понимание вопроса.

• Управление будет простым средством просмотра изображений, изображение будет нарисовано в центре элемента управления.
• Управление осуществляется от TScrollingWinControl.
• У меня есть опубликованное свойство FImage, которое является классом TPicture, что позволяет загрузить изображение в элемент управления.
• Не будет дочерних элементов управления, поскольку я буду рисовать FImage на контроле.
• В конструкторе я написал AutoScroll := False;
• Я перехватил WM_SIZE сообщений и здесь я могу определить смещения для центрирования FImage до середины контроля, а также попытаться пересчитать диапазоны прокрутки.
• Наконец, я переопределяю метод Paint, чтобы нарисовать центрированный FImage на элемент управления.

До сих пор так хорошо изображение можно загружать при проектировании или во время выполнения и отображается в центре элемента управления. Теперь я не могу понять, как правильно настроить прокрутку.

Вот соответствующий код до сих пор:

unit uImageViewer; 

interface 

uses 
    Winapi.Windows, 
    Winapi.Messages, 
    System.Classes, 
    Vcl.Controls, 
    Vcl.Forms, 
    Vcl.Graphics; 

type 
    TMyImageViewer = class(TScrollingWinControl) 
    private 
    FCanvas: TCanvas; 
    FImage: TPicture; 
    FOffsetX: Integer; // center position in control for FImage 
    FOffsetY: Integer; // center position in control for FImage 
    procedure SetImage(const Value: TPicture); 
    private 
    procedure CalculateOffsets; //recalculates the center for FImage 
    procedure CalculateScrollRanges; 
    protected 
    procedure Loaded; override; 
    procedure PaintControl; 
    procedure PaintWindow(DC: HDC); override; 
    procedure WMEraseBkGnd(var Message: TMessage); message WM_ERASEBKGND; 
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT; 
    procedure WMSize(var Message: TMessage); message WM_SIZE; 
    public 
    constructor Create(AOwner: TComponent); override; 
    destructor Destroy; override; 

    property Canvas: TCanvas read FCanvas; 
    published 
    property Align; 

    property Color; 
    property Image: TPicture read FImage write SetImage; 
    end; 

procedure Register; 

implementation 

procedure Register; 
begin 
    RegisterComponents('Standard', [TMyImageViewer]); 
end; 

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

    FCanvas := TControlCanvas.Create; 
    TControlCanvas(FCanvas).Control:=Self; 

    FImage := TPicture.Create; 
    Self.AutoSize := False; //? 
    AutoScroll := False; 

    ControlStyle := ControlStyle + [csOpaque]; 
end; 

destructor TMyImageViewer.Destroy; 
begin 
    FCanvas.Free; 
    FImage.Free; 
    inherited Destroy; 
end; 

procedure TMyImageViewer.Loaded; 
begin 
    inherited Loaded; 
    CalculateOffsets; 
    CalculateScrollRanges; 
end; 

procedure TMyImageViewer.PaintControl; 

    procedure DrawClientBackground; // paints the control color 
    begin 
    Canvas.Brush.Color := Color; 
    Canvas.Brush.Style := bsSolid; 
    Canvas.FillRect(ClientRect); 
    end; 

begin 
// if not (csDesigning in ComponentState) then 
// begin 
    DrawClientBackground; 

    // draw the FImage 
    if (FImage <> nil) and (FImage.Graphic <> nil) then 
    begin 
    Canvas.Draw(FOffsetX, FOffsetY, FImage.Graphic); 
    end; 
// end; 

end; 

procedure TMyImageViewer.PaintWindow(DC: HDC); 
begin 
    FCanvas.Handle := DC; 
    try 
    PaintControl; 
    finally 
    FCanvas.Handle := 0; 
    end; 
end; 

procedure TMyImageViewer.SetImage(const Value: TPicture); 
begin 
    if Value <> FImage then 
    begin 
    FImage.Assign(Value); 
    CalculateOffsets; 
    CalculateScrollRanges; 
    Invalidate; 
    end; 
end; 

procedure TMyImageViewer.CalculateOffsets; 
begin 
    // for centering FImage in the middle of the control 
    if FImage.Graphic <> nil then 
    begin 
    FOffsetX := (Width - FImage.Width) div 2; 
    FOffsetY := (Height - FImage.Height) div 2; 
    end; 
end; 

procedure TMyImageViewer.CalculateScrollRanges; 
begin 
    HorzScrollBar.Range:= FOffsetX + FImage.Width + FOffsetX; 
    VertScrollBar.Range:= FOffsetY + FImage.Height + FOffsetY; 
end; 

procedure TMyImageViewer.WMEraseBkGnd(var Message: TMessage); 
begin 
    Message.Result := 1; 
end; 

procedure TMyImageViewer.WMPaint(var Message: TWMPaint); 
begin 
    PaintHandler(Message); 
end; 

procedure TMyImageViewer.WMSize(var Message: TMessage); 
begin 
    inherited; 

    CalculateOffsets; 
    CalculateScrollRanges; 
    Invalidate; 
end; 

end. 

Первоначально я начал писать это в Lazarus, но хотел бы использовать его в Delphi, следовательно, обе метки были добавлены.

Как именно рассчитываются полосы прокрутки? Принимая во внимание, что детей нет или автоматическая прокрутка не включена, поэтому это должны быть ручные вычисления, я просто рисую изображение в центре элемента управления и должен знать, как рассчитать диапазоны полос прокрутки и т. Д.

Я пробовал несколько разных вещей без успеха, и мне просто кажется, что я сейчас что-то вкладываю и надеюсь на лучшее, поэтому я действительно мог бы сделать некоторые рекомендации здесь, пожалуйста.

EDIT

Так отведав работает исходный код в Delphi теперь заставило меня понять, насколько больше различных Лазарь, много вещей, которые должны были быть изменены, чтобы работать под Delphi и даже прямо сейчас полосы прокрутки исчезает.

Answer 1

Как Garth already answered, вы должны установить диапазон полосы прокрутки в размере изображения. Но этого недостаточно. Вы должны понимать, что вам нужно два разных типа поведения размещения вашего изображения: когда полоса прокрутки видима (1), вы можете панорамировать изображение в нецентральном положении, но когда полоса прокрутки не видна (2), изображение должно автоматически центрироваться. Для этого требуется аналогичное различие в вашем коде.

Кроме того, вы делаете это самостоятельно немного, желая рисовать на TScrollingWinControl.Для того, чтобы приобрести холст, самый простой способ имитируя реализации TCustomControl, что я как бы сделал в примере, показанном ниже, а затем ваш код может выглядеть следующим образом:

unit AwImageViewer; 

interface 

uses 
    Winapi.Windows, Winapi.Messages, System.Classes, Vcl.Controls, Vcl.Forms, 
    Vcl.Graphics; 

type 
    TAwImageViewer = class(TScrollingWinControl) 
    private 
    FPicture: TPicture; 
    procedure PictureChanged(Sender: TObject); 
    procedure SetPicture(Value: TPicture); 
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT; 
    protected 
    procedure PaintWindow(DC: HDC); override; 
    procedure Resize; override; 
    public 
    constructor Create(AOwner: TComponent); override; 
    destructor Destroy; override; 
    published 
    property Color; 
    property Picture: TPicture read FPicture write SetPicture; 
    end; 

implementation 

{ TAwImageViewer } 

constructor TAwImageViewer.Create(AOwner: TComponent); 
begin 
    inherited Create(AOwner); 
    FPicture := TPicture.Create; 
    FPicture.OnChange := PictureChanged; 
end; 

destructor TAwImageViewer.Destroy; 
begin 
    FPicture.Free; 
    inherited Destroy; 
end; 

procedure TAwImageViewer.PaintWindow(DC: HDC); 
var 
    Canvas: TCanvas; 
    R: TRect; 
begin 
    if FPicture.Graphic = nil then 
    inherited PaintWindow(DC) 
    else 
    begin 
    Canvas := TCanvas.Create; 
    try 
     Canvas.Lock; 
     try 
     Canvas.Handle := DC; 
     try 
      if ClientWidth > FPicture.Width then 
      R.Left := (ClientWidth - FPicture.Width) div 2 
      else 
      R.Left := -HorzScrollBar.Position; 
      if ClientHeight > FPicture.Height then 
      R.Top := (ClientHeight - FPicture.Height) div 2 
      else 
      R.Top := -VertScrollBar.Position; 
      R.Width := FPicture.Width; 
      R.Height := FPicture.Height; 
      Canvas.Draw(R.Left, R.Top, FPicture.Graphic); 
      ExcludeClipRect(DC, R.Left, R.Top, R.Right, R.Bottom); 
      FillRect(DC, ClientRect, Brush.Handle); 
     finally 
      Canvas.Handle := 0; 
     end; 
     finally 
     Canvas.Unlock; 
     end; 
    finally 
     Canvas.Free; 
    end; 
    end; 
end; 

procedure TAwImageViewer.PictureChanged(Sender: TObject); 
begin 
    HorzScrollBar.Range := FPicture.Width; 
    VertScrollBar.Range := FPicture.Height; 
    Invalidate; 
end; 

procedure TAwImageViewer.Resize; 
begin 
    HorzScrollBar.Position := (FPicture.Width - ClientWidth) div 2; 
    VertScrollBar.Position := (FPicture.Height - ClientHeight) div 2; 
    if HorzScrollBar.Position * VertScrollBar.Position = 0 then 
    Invalidate; 
    inherited Resize; 
end; 

procedure TAwImageViewer.SetPicture(Value: TPicture); 
begin 
    FPicture.Assign(Value); 
end; 

procedure TAwImageViewer.WMPaint(var Message: TWMPaint); 
begin 
    ControlState := ControlState + [csCustomPaint]; 
    inherited; 
    ControlState := ControlState - [csCustomPaint]; 
end; 

end. 

И если вы готовите вашу картину на временный растровый, то вам не нужен холст:

procedure TAwImageViewer.PaintWindow(DC: HDC); 
var 
    Bmp: TBitmap; 
    R: TRect; 
begin 
    if FPicture.Graphic = nil then 
    inherited PaintWindow(DC) 
    else 
    begin 
    Bmp := TBitmap.Create; 
    try 
     Bmp.Canvas.Brush.Assign(Brush); 
     Bmp.SetSize(ClientWidth, ClientHeight); 
     if ClientRect.Width > FPicture.Width then 
     R.Left := (ClientWidth - FPicture.Width) div 2 
     else 
     R.Left := -HorzScrollBar.Position; 
     if ClientHeight > FPicture.Height then 
     R.Top := (ClientHeight - FPicture.Height) div 2 
     else 
     R.Top := -VertScrollBar.Position; 
     R.Width := FPicture.Width; 
     R.Height := FPicture.Height; 
     Bmp.Canvas.Draw(R.Left, R.Top, FPicture.Graphic); 
     BitBlt(DC, 0, 0, ClientWidth, ClientHeight, Bmp.Canvas.Handle, 0, 0, 
     SRCCOPY); 
    finally 
     Bmp.Free; 
    end; 
    end; 
end; 

Но если поместить TImage компонент в системе управления, то все это становится гораздо проще:

unit AwImageViewer2; 

interface 

uses 
    System.Classes, Vcl.Forms, Vcl.Graphics, Vcl.ExtCtrls; 

type 
    TAwImageViewer = class(TScrollingWinControl) 
    private 
    FImage: TImage; 
    function GetPicture: TPicture; 
    procedure SetPicture(Value: TPicture); 
    protected 
    procedure Resize; override; 
    public 
    constructor Create(AOwner: TComponent); override; 
    published 
    property Color; 
    property Picture: TPicture read GetPicture write SetPicture; 
    end; 

implementation 

{ TAwImageViewer } 

constructor TAwImageViewer.Create(AOwner: TComponent); 
begin 
    inherited Create(AOwner); 
    AutoScroll := True; 
    FImage := TImage.Create(Self); 
    FImage.AutoSize := True; 
    FImage.Parent := Self; 
end; 

function TAwImageViewer.GetPicture: TPicture; 
begin 
    Result := FImage.Picture; 
end; 

procedure TAwImageViewer.Resize; 
begin 
    if ClientWidth > FImage.Width then 
    FImage.Left := (ClientWidth - FImage.Width) div 2 
    else 
    HorzScrollBar.Position := (FImage.Width - ClientWidth) div 2; 
    if ClientHeight > FImage.Height then 
    FImage.Top := (ClientHeight - FImage.Height) div 2 
    else 
    VertScrollBar.Position := (FImage.Height - ClientHeight) div 2; 
    inherited Resize; 
end; 

procedure TAwImageViewer.SetPicture(Value: TPicture); 
begin 
    FImage.Picture := Value; 
end; 

end. 

Answer 2

Просто установите диапазоны полос прокрутки в ширину и высоту изображения и смещения на позиции полосы прокрутки. Возможно, вам понадобится использовать height-Foffsety для рисования в зависимости от вашего формата растрового изображения.