⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 scrolldcu.pas

📁 Delphi Win32核心API参考光盘源码 本书包含了常用的Windows API函数
💻 PAS
字号:
unit ScrollDCU;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Image1: TImage;
    ScrollBar1: TScrollBar;
    ScrollBar2: TScrollBar;
    procedure FormCreate(Sender: TObject);
    procedure ScrollBar1Change(Sender: TObject);
    procedure ScrollBar2Change(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  PreviousX, PreviousY: Integer;     // tracks the previous scroll offset

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  {initialize the scroll bars}
  ScrollBar1.Max := Image1.Picture.Bitmap.Width-Image1.Width;
  ScrollBar2.Max := Image1.Picture.Bitmap.Height-Image1.Height;

  {initialize the offset tracking variables}
  PreviousX := 0;
  PreviousY := 0;
end;

procedure TForm1.ScrollBar1Change(Sender: TObject);
var
  ScrollRect,              // the rectangular area to be scrolled
  ClipRect,                // the clipping rectangle of the scrolled area
  UpdateRect: TRect;       // the area uncovered by scrolling
begin
  {initialize the scrolling and clipping rectangles to the entire area
   of the image}
  ScrollRect := Image1.BoundsRect;
  ClipRect := Image1.BoundsRect;

  {scroll the area horizontally by the specified amount}
  ScrollDC(Canvas.Handle, PreviousX-ScrollBar1.Position, 0, ScrollRect,
           ClipRect, 0, @UpdateRect);

  {copy the appropriate area of the original bitmap into the newly uncovered
   area}
  Canvas.CopyRect(UpdateRect, Image1.Picture.Bitmap.Canvas,
                  Rect((UpdateRect.Left-Image1.Left)+ScrollBar1.Position,
                  ScrollBar2.Position, (UpdateRect.Left-Image1.Left)+
                  ScrollBar1.Position+(UpdateRect.Right-UpdateRect.Left),
                  Image1.Height+ScrollBar2.Position));

  {record the current position}
  PreviousX := ScrollBar1.Position;
end;

procedure TForm1.ScrollBar2Change(Sender: TObject);
var
  ScrollRect,              // the rectangular area to be scrolled
  ClipRect,                // the clipping rectangle of the scrolled area
  UpdateRect: TRect;       // the area uncovered by scrolling
begin
  {initialize the scrolling and clipping rectangles to the entire area
   of the image}
  ScrollRect := Image1.BoundsRect;
  ClipRect := Image1.BoundsRect;

  {scroll the area vertically by the specified amount}
  ScrollDC(Canvas.Handle, 0, PreviousY-ScrollBar2.Position, ScrollRect,
           ClipRect, 0, @UpdateRect);

  {copy the appropriate area of the original bitmap into the newly uncovered
   area}
  Canvas.CopyRect(UpdateRect, Image1.Picture.Bitmap.Canvas,
                  Rect(ScrollBar1.Position, (UpdateRect.Top-Image1.Top)+
                  ScrollBar2.Position, Image1.Width+ScrollBar1.Position,
                  (UpdateRect.Top-Image1.Top)+ScrollBar2.Position+
                  (UpdateRect.Bottom-UpdateRect.Top)));

  {record the current position}
  PreviousY := ScrollBar2.Position;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -