图片的放大缩小问题 (100分)

  • 主题发起人 主题发起人 qmwuu
  • 开始时间 开始时间
Q

qmwuu

Unregistered / Unconfirmed
GUEST, unregistred user!
1、在Image中显示jpeg文件的全部。
2、能否将Image中的jpeg文件进行局部的放大,或缩小。
 
var
Bitmap: TBitmap;
MyRect, MyOther: TRect;
begin

MyRect := Rect(10,10,100,100);

MyOther := Rect(10,111,100, 201);
Bitmap := TBitmap.Create;
Bitmap.LoadFromFile('c:/windows/tartan.bmp');
Form1.Canvas.BrushCopy(MyRect, Bitmap, MyRect, clBlack);
Form1.Canvas.CopyRect(MyOther,Bitmap.Canvas,MyRect);
Bitmap.Free;
end;
 
自已研究一下如需要源码发Email给我yczjs@163.com
var
Form1: TForm1;
StoreWidth,StoreHeight: integer;

implementation

{$R *.DFM}

procedure TForm1.ZoomImage (SetWidth: integer; SetHeight: integer);
var Bitmap: TBitmap;
DstRect: TRect;
begin
{ Refresh first -- needed as one maked the image really big first}
Image1.Picture.Graphic.LoadFromFile('dolphin.bmp');

Bitmap := TBitmap.Create;
Bitmap.Width := SetWidth;
Bitmap.Height := SetHeight;

Bitmap.Canvas.StretchDraw(Bitmap.Canvas.ClipRect,Image1.Picture.Graphic);

Image1.Picture.Graphic := Bitmap;
Image1.Invalidate; //quite important...
end;

procedure TForm1.BitBtn_ResizeClick(Sender: TObject);
begin
ZoomImage (strtoint(Edit_Width.Text),strtoint(Edit_Height.Text));
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Label_Width.Caption := 'Width: (' + inttostr(Image1.Width)+')';
Edit_Width.Text := inttostr(Image1.Width);
Label_Height.Caption := 'Height: (' + inttostr(Image1.Height)+')';
Edit_Height.Text := inttostr(Image1.Height);
StoreWidth := Image1.Width; StoreHeight := Image1.height;
end;

procedure TForm1.SpinButton_WidthDownClick(Sender: TObject);
begin
Edit_Width.Text := IntToStr(StrToInt(Edit_Width.Text) div 2);
if CheckBox_KeepAspectRatio.Checked then
Edit_Height.Text := IntToStr(StrToInt(Edit_Height.Text) div 2);
end;

procedure TForm1.SpinButton_HeightDownClick(Sender: TObject);
begin
Edit_Height.Text := IntToStr(StrToInt(Edit_Height.Text) div 2);
if CheckBox_KeepAspectRatio.Checked then
Edit_Width.Text := IntToStr(StrToInt(Edit_Width.Text) div 2);
end;

procedure TForm1.SpinButton_HeightUpClick(Sender: TObject);
begin
Edit_Height.Text := IntToStr(StrToInt(Edit_Height.Text) * 2);
if CheckBox_KeepAspectRatio.Checked then
Edit_Width.Text := IntToStr(StrToInt(Edit_Width.Text) * 2);
end;

procedure TForm1.SpinButton_WidthUpClick(Sender: TObject);
begin
Edit_Width.Text := IntToStr(StrToInt(Edit_Width.Text) * 2);
if CheckBox_KeepAspectRatio.Checked then
Edit_Height.Text := IntToStr(StrToInt(Edit_Height.Text) * 2);
end;

procedure TForm1.BitBtn_ResetClick(Sender: TObject);
begin
ZoomImage(StoreWidth,StoreHeight);
end;
 
多人接受答案了。
 
后退
顶部