Показать сообщение отдельно
  #8  
Старый 19.05.2009, 20:40
Nyctos Kasignete Nyctos Kasignete вне форума
Активный
 
Регистрация: 29.03.2009
Сообщения: 300
Репутация: 94
По умолчанию

У меня никаких ошибок не вылазит. Вот полностью рабочий пример. Прокручиваем картинку (setup.bmp из директории %windir%\system32) в ScrollBox с помощью колеса мыши.

pas-файл:
Код:
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    ScrollBox1: TScrollBox;
    Image1: TImage;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    procedure WMMOUSEWHEEL(var Msg: TMessage); message WM_MOUSEWHEEL;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.WMMOUSEWHEEL(var Msg: TMessage);
var
  zDelta: Integer;
begin
  inherited;
 // if WindowFromPoint(Mouse.CursorPos) <> ScrollBox1.Handle then Exit;
  if Msg.WParam < 0 then zDelta := -10 else zDelta := 10;
  with ScrollBox1 do
  begin
    if ((VertScrollBar.Position = 0) and
        (zDelta > 0)) or
       ((VertScrollBar.Position = VertScrollBar.Range - ClientHeight) and
        (zDelta < 0)) then Exit;
    ScrollBy(0, zDelta);
    VertScrollBar.Position := VertScrollBar.Position - zDelta;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  WinDir: PChar;
begin
  GetMem(WinDir, MAX_PATH);
  try
    GetWindowsDirectory(WinDir, MAX_PATH);
    if not FileExists(StrPas(WinDir) + '\System32\setup.bmp') then Exit;
    Image1.Picture.Bitmap.LoadFromFile(StrPas(WinDir) + '\System32\setup.bmp');
  finally
    FreeMem(WinDir, MAX_PATH);
  end;
end;

end.

dfm-файл:
Код:
object Form1: TForm1
  Left = 192
  Top = 114
  Width = 696
  Height = 480
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object ScrollBox1: TScrollBox
    Left = 16
    Top = 16
    Width = 377
    Height = 169
    TabOrder = 0
    object Image1: TImage
      Left = 0
      Top = 0
      Width = 150
      Height = 150
      AutoSize = True
    end
  end
end
Ответить с цитированием