图片问题 ( 积分: 100 )

1、在D7中怎样做到像XP 图片浏览器中的一个 最适合大小 功能（主要难度是其比例问题）
2、怎样捕捉MOUSE 滚轴（即左键和右键之间的那个）向前向后事件。

特急！
谢谢！

1、Image可以缩放图片。
2、部分控件就有滚轮的事件。

TO：nicai_wgl
我知道IMAGE有宿放功能，主要是要怎样做到 最适合大小？
滚轮事件是哪一个？

适应大小是不是可以理解成，高度限制就适应高度，宽度限制就适应宽度。
TForm就有事件OnMouseWheel/Down/Up

TO：nicai_wgl
举个例：有一张图片，其尺寸很大，我现在要缩小成200*200，如果按IMAGE缩放功能，图片中的字体会变形

呵呵，我也遇到过，图片的长和宽都按同样的比例缩小，而且还有考虑像素点的整数关系。
比如长，宽为2000/1000，缩小为1000/500应该是没多少失真的，如果250/125.5就有失真了
，像素点只能整个显示。

TO:nicai_wgl
最终有没搞定?
还请教

最后结果，图片缩放后字体肯定会变形的，比例合适失真程度小点。

请各位大侠路过指点一下
2、怎样捕捉MOUSE 滚轴（即左键和右键之间的那个）向前向后事件。
是指捕捉IMAGE 滚轮事件

MouseWheel

--------------------------------
图形图像组件
http://www.codeidea.com

第二个问题自己已搞定，第一个问题请各位大侠帮忙。谢谢！

TO：壁画 在不，帮我搞定一下！谢谢！

我的控件，你参考里面的代码，你要求的功能都有。
//冯思锐原创
//献给我的红颜知己，王莉。

unit FastPictureView;

interface

uses
Windows, Messages, SysUtils, Classes, Controls, graphics, ExtCtrls, jpeg,
myfunctions, cnGraphics;

const
crHandUp = 5;

type

TFastPictureView = class;

TinTimer = Class(TTimer)
private
Fkey: Word;
Fpv: TFastPictureView;
procedure doTimer(Sender: TObject);
public
constructor create(AOwner: TFastPictureView; key: Word); overload;
end;

TFastPictureView = class(Tcustomcontrol)
private
{ Private declarations }
FbfTop: integer;
FbfLeft: integer;
FPicture: TPicture;
bfBmp: TBitMap;
FZoomPercent: integer;
FbkColor: TColor;
FbfPR: TRect;
FcanMoveX: boolean;
FcanMoveY: boolean;
oldX, oldY: integer;
oldRect: TRect;
crHandDown: HICON;
FzpChange: TNotifyEvent;
FrtState: integer;
Fmarking: string;
FTimer: TinTimer;
FOnPictureChange: TNotifyEvent;
procedure setPicture(const Value: TPicture);
procedure setZoomPercent(const Value: integer);
procedure SetbkColor(const Value: TColor);
procedure PictureChange(sender: TObject);
procedure PaintBackGround;
procedure PaintPicture;
procedure setbfPR(const Value: TRect);
function displayRect: TRect;
procedure SetrtState(const Value: integer);
procedure IniBufferBmp;
function pfmouseWheel(up: boolean): boolean;
procedure Setmarking(const Value: string);
procedure WriteMark(bmp: TBitmap);
// procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
procedure WMGetDlgCode(var Msg: TWMGetDlgCode); message WM_GETDLGCODE;
protected
{ Protected declarations }
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;
function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
procedure Paint; override;
procedure wmSize(var msg: Tmessage); message WM_SIZE;
procedure wmEraseBkgnd(var msg: Tmessage); message WM_ERASEBKGND;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure KeyUp(var Key: Word; Shift: TShiftState); override;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure LoadFromFile(FileName: string);
procedure LoadJpegStream(stream: TStream);
procedure Assign(Source: TPersistent); override;
procedure print;
procedure printEx;
procedure loaded; override;
procedure Rotate(Angle: integer);
procedure ReInit;
property RotateState: integer read FrtState write SetrtState;
published
{ Published declarations }
property Picture: TPicture read FPicture write setPicture;
property ZoomPercent: integer read FZoomPercent write setZoomPercent;
property BackGroundColor: TColor read FbkColor write SetbkColor;
property bfpaintRect: TRect read FbfPR write setbfPR;
property ZoomPercentChange: TNotifyEvent read FzpChange write FzpChange;
property OnPictureChange: TNotifyEvent read FOnPictureChange write FOnPictureChange;
property marking: string read Fmarking write Setmarking;
property Align;
property popupMenu;
property OndblClick;
property OnContextPopup;
property ShowHint;
property ParentShowHint;

end;

procedure Register;

implementation

{$R *.DCR}

uses math, dialogs, forms, printers;

procedure Register;
begin
RegisterComponents('Samples', [TFastPictureView]);
end;

{ TFastPictureView }

constructor TFastPictureView.Create(AOwner: TComponent);
begin
inherited create(Aowner);
FZoomPercent:=100;
FPicture:=TPicture.Create;
bfBmp:=TBitMap.Create;
Fpicture.OnChange:=PictureChange;
FbfTop:=0;
FbfLeft:=0;
Width:=100;
height:=100;
FbkColor:=clBackground;
DoubleBuffered:=true;
screen.Cursors[crHandUp]:= LoadCursor(HInstance, 'HandUp');
crHandDown := LoadCursor(HInstance, 'HandDown');
end;

destructor TFastPictureView.Destroy;
begin
bfBmp.Free;
FPicture.Free;
inherited;
end;


procedure TFastPictureView.PaintPicture;
begin
canvas.copyRect(DisplayRect, bfBmp.Canvas, bfPaintRect);
end;

procedure TFastPictureView.LoadFromFile(FileName: string);
begin
FPicture.LoadFromFile(FileName);
end;

procedure TFastPictureView.MouseDown(Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
windows.SetFocus(handle);
if ptInRect(DisplayRect, point(x, y)) and (button=mbLeft) then
begin
oldX:=x;
oldY:=y;
OldRect:=bfPaintRect;
FCanmoveX:=bfBmp.Width>clientWidth;
FcanMoveY:=bfBmp.Height>clientHeight;
SetCursor(crHandDown);
end;
end;

procedure TFastPictureView.MouseMove(Shift: TShiftState; X, Y: Integer);
var
R: TRect;
offX, offY: integer;
begin
offx:=0;
offy:=0;
if FcanMoveX then offx:=oldX-x;
if FCanMoveY then offy:=oldY-y;
if (offx<>0) or (offy<>0) then
begin
R:=oldRect;
offsetRect(R, offx, offy);
bfpaintRect:=R;
end;
if ptInRect(DisplayRect, point(x, y)) then
cursor:=crHandUp
else
cursor:=crDefault;
end;

procedure TFastPictureView.MouseUp(Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FcanMoveX:=false;
FcanMoveY:=false;
Cursor:=crHandUp;
end;

procedure TFastPictureView.Paint;
begin
paintBackGround;
PaintPicture;
end;

procedure TFastPictureView.PictureChange(sender: TObject);
begin
FrtState:=0;
IniBufferBmp;
if assigned(FonPicturechange) then FonPicturechange(self);
end;

procedure TFastPictureView.setbfPR(const Value: TRect);
var
R: TRect;
begin
R:=value;
if bfBmp.Width>clientWidth then
begin
if R.Left<0 then R.Left:=0;
if R.Left+ClientWidth>bfBmp.Width then R.Left:=bfBmp.Width-clientWidth;
R.Right:=R.Left+clientWidth;
end
else
begin
R.Left:=0;
R.Right:=bfBmp.Width;
end;

if bfBmp.Height>ClientHeight then
begin
if R.Top<0 then R.Top:=0;
if R.Top+ClientHeight>bfBmp.Height then R.Top:=bfBmp.Height-ClientHeight;
R.Bottom:=R.Top+clientHeight;
end
else
begin
R.Top:=0;
R.Bottom:=bfBmp.Height;
end;
if not equalRect(R, FbfPR) then
begin
FbfPR:=R;
PaintPicture;
end;
end;

procedure TFastPictureView.SetbkColor(const Value: TColor);
begin
FbkColor := Value;
canvas.Brush.Color:=value;
Invalidate;
end;

procedure TFastPictureView.setPicture(const Value: TPicture);
begin
FPicture.Assign(Value);
end;

procedure TFastPictureView.setZoomPercent(const Value: integer);
begin
{ if (value<10) or (value>400) then
begin
MessageBox(handle, pchar('请设置缩放比例在10%-200%之间'),pchar('缩放比例'),
MB_OK or MB_ICONERROR);
exit;
end;
}
if FZoomPercent <> Value then
begin
FZoomPercent := Value;
IniBufferBmp;
if Assigned(FzpChange) then FzpChange(self);
end;
end;

procedure TFastPictureView.wmEraseBkgnd(var msg: Tmessage);
begin
msg.Result:=1;
end;

procedure TFastPictureView.wmSize(var msg: Tmessage);
begin
bfPaintRect:=FbfPR;
end;

procedure TFastPictureView.PaintBackGround;
var
rleft, RRight: TRect;
rTop, rbottom: TRect;
begin
if clientWidth>bfBmp.Width then
begin
rLeft:=Rect(0, 0, (clientWidth-bfBmp.Width) div 2, clientHeight);
rRight:=Rect(clientWidth-(clientWidth-bfBmp.Width) div 2,
0, clientWidth, clientHeight);
canvas.FillRect(rLeft);
canvas.FillRect(rRight);
end;
if ClientHeight>bfBmp.Height then
begin
rTop:=Rect(0, 0, clientWidth,(clientHeight-bfBmp.Height) div 2);
rBottom:=Rect(0, clientHeight-(clientheight-bfBmp.Height) div 2,
clientWidth, clientHeight);
canvas.FillRect(rTop);
canvas.FillRect(rBottom);
end;
end;

procedure TFastPictureView.LoadJpegStream(stream: TStream);
var
jpg: TJpegImage;
begin
jpg:=TJpegImage.Create;
try
stream.Position:=0;
jpg.LoadFromStream(stream);
Fpicture.Assign(jpg);
finally
jpg.Free;
end;
end;

function TFastPictureView.displayRect: TRect;
var
pr: TRect;
begin
pr:=ClientRect;
if bfBmp.Width<clientWidth then
begin
pr.Left:=(clientWidth-bfBmp.Width) div 2;
pr.Right:=clientWidth-(clientWidth-bfBmp.Width) div 2;
end;
if bfBmp.Height<ClientHeight then
begin
pr.Top:=(ClientHeight-bfbmp.Height) div 2;
pr.Bottom:=ClientHeight-(ClientHeight-bfBmp.Height) div 2;
end;
result:=pr;
end;

procedure TFastPictureView.loaded;
begin
inherited loaded;
FbfPR:=clientRect;
end;

procedure TFastPictureView.print;
var
R: TRect;
bmp: TBitMap;
cbmp: TcnBitMap;
begin
if Picture=nil then exit;
bmp:=TBitMap.Create;
cbmp:=TcnBitmap.Create;
bmp.PixelFormat:=pf24bit;
try
with printer, printer.Canvas do
begin
beginDoc;
R:=ClipRect;
R:=FitRect(R, Fpicture.Width, FPicture.Height);
bmp.Assign(Fpicture.Graphic);
if Fmarking<>'' then WriteMark(bmp);
cbmp.Assign(bmp);
cbmp.StretchDrawTo(handle, R);
endDoc;
end;
finally
cbmp.Free;
bmp.Free;
end;
end;


procedure TFastPictureView.Rotate(Angle: integer);
begin
bfPaintRect:=FbfPR;
RotateState:=FrtState+Angle;
end;

procedure TFastPictureView.SetrtState(const Value: integer);
begin
if FrtState <> Value then
begin
FrtState := Value mod 4;
IniBufferBmp;
end;
end;

procedure TFastPictureView.IniBufferBmp;
var
cbmp: TcnBitmap;
begin
if (FPicture=nil) or (FPicture.Width<=0) or (Fpicture.Height<=0) then
begin
bfBmp.Width:=0;
bfbmp.Height:=0;
exit;
end;
dobusy(true);
cbmp:=Tcnbitmap.Create;
try
case FZoomPercent of
0 : //适应宽度；
begin
bfbmp.Height:=Fpicture.Height*Parent.ClientWidth div Fpicture.Width;
bfBmp.Width:=Parent.ClientWidth;
end;
1 : //适应高度
begin
bfbmp.Width:=Fpicture.Width*Parent.ClientHeight div Fpicture.Height;
bfBmp.Height:=Parent.ClientHeight;
end;
2 : begin

end;
else
begin
bfBmp.Height:=Fpicture.Height*FZoomPercent div 100;
bfBmp.Width:=Fpicture.Width*FZoomPercent div 100;
end;
end;
cbmp.SetSize(bfbmp.Width, bfbmp.Height);
if Fpicture.Graphic<>nil then
cbmp.StretchDraw(FPicture.Graphic);
bfBmp.Assign(cbmp);
bfBmp.PixelFormat:=pf24bit;
if Fmarking<>'' then writeMark(bfBmp);
RotateBmp(bfBmp, FrtState);
bfpaintRect:=FbfPR;
Invalidate;
finally
cbmp.Free;
dobusy(false);
end;
end;

function TFastPictureView.DoMouseWheelUp(Shift: TShiftState;
MousePos: TPoint): Boolean;
begin
result:=pfmouseWheel(false);
end;

function TFastPictureView.DoMouseWheelDown(Shift: TShiftState;
MousePos: TPoint): Boolean;
begin
Result := pfmouseWheel(true);
end;

function TFastPictureView.pfmouseWheel(up: boolean): boolean;
var
i: integer;
R: TRect;
begin
R:=bfPaintRect;;
for i:=0 to 60 do
begin
if up then offsetRect(R, 0, 2)
else offsetRect(R, 0, -2);
bfpaintRect:=R;
end;
Result := True;
end;

procedure TFastPictureView.Setmarking(const Value: string);
begin
Fmarking := Value;
end;

procedure TFastPictureView.WriteMark(bmp: TBitmap);
var
mark: TcnSignet;
begin
mark:=TcnSignet.Create;
try
mark.Color:=clBlue;
mark.BkColor:=clWhite;
mark.TransColor:=clwhite;
mark.Alhap:=84;
mark.Text:=Fmarking;
mark.FontSize:=max(Bmp.Width, Bmp.Height) div 25;
mark.Angle:=-15;
mark.DrawOn(bmp.Canvas.Handle, bmp.Width div 7, bmp.Height div 7);
finally
mark.Free;
end;
end;


procedure TFastPictureView.ReInit;
begin
IniBufferBmp;
end;

procedure TFastPictureView.KeyDown(var Key: Word; Shift: TShiftState);
var
R: TRect;
begin
if (key in [VK_LEFT..VK_DOWN]) and (FTimer=nil) then
FTimer:=TinTimer.create(self, key);
end;

procedure TFastPictureView.WMGetDlgCode(var Msg: TWMGetDlgCode);
begin
inherited;
msg.Result := msg.Result or DLGC_WANTARROWS;
end;

procedure TFastPictureView.KeyUp(var Key: Word; Shift: TShiftState);
begin
inherited;
if FTimer<>nil then FreeAndnil(FTimer);
end;


procedure TFastPictureView.Assign(Source: TPersistent);
begin
if Source is TGraphic then
FPicture.Assign(Source)
else
inherited Assign(Source);
end;

procedure TFastPictureView.printEx;
var
R: TRect;
bmp: TBitMap;
cbmp: TcnBitMap;
begin
if Picture=nil then exit;
bmp:=TBitMap.Create;
// cbmp:=TcnBitmap.Create;
bmp.PixelFormat:=pf24bit;
try
with printer, printer.Canvas do
begin
beginDoc;
R:=Rect(0, 0, PageWidth, pageHeight);
R:=FitRect(R, Fpicture.Width, FPicture.Height);
bmp.Assign(Fpicture.Graphic);
if Fmarking<>'' then WriteMark(bmp);
// cbmp.Assign(bmp);
// cbmp.StretchDrawTo(handle, R);
StretchDraw(R, bmp);
endDoc;
end;
finally
// cbmp.Free;
bmp.Free;
end;
end;

{ TinTimer }

constructor TinTimer.create(AOwner: TFastPictureView; key: Word);
begin
Fkey:=key;
Fpv:=TFastPictureView(AOwner);
inherited create(Fpv);
Interval:=1;
OnTimer:=doTimer;
Enabled:=true;
end;

procedure TinTimer.doTimer(Sender: TObject);
var
R: TRect;
i: integer;
begin
for i:=0 to 3 do
begin
R:=Fpv.bfpaintRect;
case Fkey of
VK_UP : offsetRect(R, 0, -1);
VK_DOWN: offsetRect(R, 0, 1);
VK_LEFT: offsetRect(R, -1, 0);
VK_RIGHT: offsetRect(R, 1, 0);
end;
Fpv.bfpaintRect:=R;
end;
end;

end.