unit main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ComCtrls,
myZoomBox;
type
TForm1 =
class(TForm)
Panel1: TPanel;
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
CheckBox3: TCheckBox;
CheckBox4: TCheckBox;
Button1: TButton;
CheckBox5: TCheckBox;
Panel2: TPanel;
TrackBar1: TTrackBar;
Timer1: TTimer;
procedure FormCreate (Sender: TObject);
procedure TrackBar1Change(Sender: TObject);
procedure CheckBox1Click (Sender: TObject);
procedure CheckBox2Click (Sender: TObject);
procedure CheckBox3Click (Sender: TObject);
procedure CheckBox4Click (Sender: TObject);
procedure CheckBox5Click (Sender: TObject);
procedure Button1Click (Sender: TObject);
procedure Timer1Timer (Sender: TObject);
procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
private
{ Private 宣言 }
ZoomBox1 : TZoomBox;
//ちらつきを抑えるため
procedure WMEraseBkGnd(
var Msg: TMessage);
message WM_ERASEBKGND;
//ディスプレイ設定の変更を捕らえる
procedure WMDisplayChange(
var Msg: TMessage);
message WM_DISPLAYCHANGE;
//ルーペモード実現のため
procedure WMMove(
var Msg: TWMMove);
message WM_MOVE;
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
uses
Clipbrd;
{$R *.dfm}
procedure TForm1.WMEraseBkGnd(
var Msg: TMessage);
//ちらつきを抑えるため
begin
//http://hpcgi1.nifty.com/MADIA/DelphiBBS/wwwlng.cgi?print+200504/05040066.txt
Msg.Result:=0;
end;
procedure TForm1.WMDisplayChange(
var Msg: TMessage);
//ディスプレイ設定の変更を反映
begin
ZoomBox1.DisplayChange(
nil);
end;
procedure TForm1.WMMove(
var Msg: TWMMove);
//ルーペモード実現のため
begin
if (CheckBox5.Checked)
then begin
ZoomBox1.Position := ZoomBox1.ClientOrigin;
Msg.Result := 0;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
ZoomBox1 := TZoomBox.Create(Self);
ZoomBox1.Align := alClient;
ZoomBox1.BGColor := clBlack;
ZoomBox1.IsCenter := CheckBox1.Checked;
ZoomBox1.IsLayeredWindow := CheckBox2.Checked;
ZoomBox1.IsMouseCursor := CheckBox3.Checked;
ZoomBox1.IsDragPosition :=
not(CheckBox4.Checked);
TrackBar1.Position := 2;
TrackBar1Change(
nil);
Timer1.Enabled := True;
end;
procedure TForm1.TrackBar1Change(Sender: TObject);
begin
//ズーム倍率
ZoomBox1.Zoom := TrackBar1.Position;
Self.Caption := Format('%d倍', [ZoomBox1.Zoom]);
end;
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
//キャプチャポイントを表示画面の真ん中に持ってくるか
ZoomBox1.IsCenter := CheckBox1.Checked;
end;
procedure TForm1.CheckBox2Click(Sender: TObject);
begin
//レイヤードウィンドウをキャプチャするか
ZoomBox1.IsLayeredWindow := CheckBox2.Checked;
end;
procedure TForm1.CheckBox3Click(Sender: TObject);
begin
//マウスカーソルをキャプチャするか
ZoomBox1.IsMouseCursor := CheckBox3.Checked;
end;
procedure TForm1.CheckBox4Click(Sender: TObject);
begin
if (CheckBox4.Checked)
then begin
//カーソル追従
ZoomBox1.IsDragPosition := False;
end else begin
//マウスでつかんで移動
ZoomBox1.IsDragPosition := True;
end;
end;
procedure TForm1.CheckBox5Click(Sender: TObject);
//ルーペモード
begin
if (CheckBox5.Checked)
then begin
Self.AlphaBlend := True;
CheckBox2.Checked := False;
//レイヤードウィンドウはキャプチャしない
CheckBox2Click(
nil);
CheckBox4.Checked := False;
//カーソル追従しない
CheckBox4Click(
nil);
ZoomBox1.IsDragPosition := False;
//ドラッグしてキャプチャポイントの移動はしない
ZoomBox1.Position := ZoomBox1.ClientOrigin;
end else begin
Self.AlphaBlend := False;
CheckBox4Click(
nil);
//ドラッグしてキャプチャポイントの移動のセット
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
lpt_Pos : TPoint;
begin
if (CheckBox4.Checked)
then begin
//カーソル追従
GetCursorPos(lpt_Pos);
//現在のマウスカーソルの位置を取得して
ZoomBox1.Position := lpt_Pos;
//キャプチャポイントにセット
end else begin
//定点キャプチャ、ルーペモード
ZoomBox1.Capture;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
//クリップボードへコピー
var
l_Bitmap : TBitmap;
begin
l_Bitmap := TBitmap.Create;
try
ZoomBox1.GetBitmap(l_Bitmap);
Clipboard.Assign(l_Bitmap);
finally
l_Bitmap.Free;
end;
end;
procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
//フォーム移動
begin
ReleaseCapture;
SendMessage(Self.Handle, WM_SYSCOMMAND, WPARAM(SC_SIZE
or 9), 0);
end;
end.
