我的问题是我正在尝试开发的自定义控件,我似乎无法弄清楚如何正确实现滚动条。我将在关键点强调我正在努力使问题更容易理解。
TScrollingWinControl
。FImage
的已发布属性,它是一个TPicture
类,可以将图像加载到控件中。FImage
绘制到控件上。AutoScroll := False;
WM_SIZE
消息,在这里我确定了将FImage
居中到控件中间的偏移量,并尝试重新计算滚动范围。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中使用它,因此添加了两个标签。
滚动条究竟应该如何计算?请记住,没有启用子项或自动滚动,因此必须手动计算,我只是在控件的中心绘制图像,需要知道如何计算滚动条范围等。
我尝试了一些不同的事情但没有成功,看起来我现在正在投入任何东西,并希望最好的,所以我真的可以在这里做一些指导。
修改
因此尝试在Delphi中运行原始代码现在让我意识到Lazarus有多么不同,在Delphi下运行很多东西甚至现在滚动条正在消失。
答案 0 :(得分: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.
答案 1 :(得分:0)
只需将滚动条范围设置为图像的宽度和高度,并将偏移设置为滚动条位置。您可能需要使用height-Foffsety来绘制,具体取决于您的位图格式。