Delphi-Projects

1
unit PreviewUnit;
2

3
interface
4

5
uses
6
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7
  Dialogs, ExtCtrls, Menus;
8

9
type
10
  TPreviewForm = class(TForm)
11
    ScrollBox: TScrollBox;
12
    Image: TImage;
13
    PopupMenu: TPopupMenu;
14
    Exit: TMenuItem;
15
    Bevel: TBevel;
16
    procedure FormKeyPress(Sender: TObject; var Key: Char);
17
    procedure ExitClick(Sender: TObject);
18
    procedure ScrollBoxMouseWheel(Sender: TObject; Shift: TShiftState;
19
      WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
20
    procedure FormCreate(Sender: TObject);
21
    procedure ImageMouseMove(Sender: TObject; Shift: TShiftState; X,
22
      Y: Integer);
23
    procedure ImageMouseDown(Sender: TObject; Button: TMouseButton;
24
      Shift: TShiftState; X, Y: Integer);
25
  private
26
    { Private declarations }
27
    PrevX, PrevY: Integer;
28
  public
29
    { Public declarations }
30
  end;
31

32
var
33
  PreviewForm: TPreviewForm;
34

35
implementation
36

37
{$R *.dfm}
38

39
procedure TPreviewForm.FormKeyPress(Sender: TObject; var Key: Char);
40
begin
41
  case Ord(Key) of
42
    VK_Space, VK_Escape, VK_Return:
43
      ExitClick(Sender);
44
    8, VK_Up:
45
      Image.Top := Image.Top + 120;
46
    2, VK_Down:
47
      Image.Top := Image.Top - 120;
48
    6, VK_Right:
49
      Image.Left := Image.Left + 120;
50
    4, VK_Left:
51
      Image.Left := Image.Left - 120;
52
  end;
53
end;
54

55
procedure TPreviewForm.ExitClick(Sender: TObject);
56
begin
57
  Close;
58
end;
59

60
procedure TPreviewForm.ScrollBoxMouseWheel(Sender: TObject;
61
  Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint;
62
  var Handled: Boolean);
63
var
64
  H, W: Integer;
65
begin
66
  with Image do
67
  begin
68
  H := Height;
69
  W := Width;
70
  Stretch := True;
71
  if ssLeft in Shift then
72
  begin
73
    Top := 0;
74
    Height := Height - WheelDelta;
75
    Width := MulDiv(Height, W, H);
76
  end
77
  else
78
    if (Top < 0) and (WheelDelta > 0) then
79
      ScrollBox.ScrollBy(0, WheelDelta);
80
    if ((Top + Height) > ScrollBox.ClientHeight) and (WheelDelta < 0) then
81
      ScrollBox.ScrollBy(0, WheelDelta);
82
  Bevel.SetBounds(Left, Top, Width + 1,Height + 1);
83
  {
84
  Caption := Format('%d %d %d %d', [
85
    WheelDelta,
86
    Image.Top,
87
    Image.Top + Image.Height,
88
    ScrollBox.ClientHeight
89
    ]);
90
  }
91
  end;
92
  //ScrollBox.ScaleBy(3, 4);
93
  Handled := True;
94
end;
95

96
procedure TPreviewForm.FormCreate(Sender: TObject);
97
begin
98
  //ScrollBox.ScrollInView(Image);
99
end;
100

101
procedure TPreviewForm.ImageMouseMove(Sender: TObject; Shift: TShiftState;
102
  X, Y: Integer);
103
begin
104
  if ssLeft in Shift then
105
    with TImage(Sender) do
106
    begin
107
      SetBounds(Left + X - PrevX, Top + Y - PrevY, Width, Height);
108
      Bevel.SetBounds(Left, Top, Width + 1, Height + 1);
109
    end;
110
end;
111

112
procedure TPreviewForm.ImageMouseDown(Sender: TObject;
113
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
114
begin
115
  PrevX := X;
116
  PrevY := Y;
117
end;
118

119
end.
120