Mega Code Archive
Basics of Graphics zooming
<![CDATA[
Title: Basics of Graphics-zooming
Question: How can I have image-zooming with the components Delphi
has?
Answer:
It is for the best that you download the file that belongs to this article.
It gives you an idea of how to do that (only basic-knowlegde, but well
worked out)
To those not willing to download it, here's the code:
unit Unit1;
{ Programmed for www.delphi3000.com
by ALI BABA Computin' (Omer Yasar Can)}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
jpeg, ExtCtrls, StdCtrls, Buttons, ComCtrls, Spin;
type
TForm1 = class(TForm)
Image1: TImage;
Panel1: TPanel;
BitBtn_Resize: TBitBtn;
Label_Width: TLabel;
Label_Height: TLabel;
Edit_Width: TEdit;
Edit_height: TEdit;
StatusBar1: TStatusBar;
SpinButton_Width: TSpinButton;
SpinButton_Height: TSpinButton;
CheckBox_KeepAspectRatio: TCheckBox;
BitBtn_Reset: TBitBtn;
procedure BitBtn_ResizeClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure SpinButton_WidthDownClick(Sender: TObject);
procedure SpinButton_HeightDownClick(Sender: TObject);
procedure SpinButton_HeightUpClick(Sender: TObject);
procedure SpinButton_WidthUpClick(Sender: TObject);
procedure BitBtn_ResetClick(Sender: TObject);
private
{ Private-Deklarationen }
procedure ZoomImage (SetWidth: integer; SetHeight: integer);
public
{ Public-Deklarationen }
end;
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;
end.
--------------------------------------------------------------------
here is unit1.dfm:
object Form1: TForm1
Left = 344
Top = 127
Width = 346
Height = 527
Caption = 'Delphi-programming -- HOW TO -- Cath.:Graph'
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 Image1: TImage
Left = 0
Top = 0
Width = 269
Height = 381
AutoSize = True
Picture.Data = {
........here timage.picture.......................
..................................................
end
object Panel1: TPanel
Left = 0
Top = 384
Width = 337
Height = 97
BevelWidth = 3
TabOrder = 0
object Label_Width: TLabel
Left = 24
Top = 40
Width = 101
Height = 20
Caption = 'Label_Width'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
end
object Label_Height: TLabel
Left = 24
Top = 64
Width = 108
Height = 20
Caption = 'Label_Height'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
end
object BitBtn_Resize: TBitBtn
Left = 8
Top = 8
Width = 75
Height = 25
Caption = '&Resize'
TabOrder = 0
OnClick = BitBtn_ResizeClick
end
object Edit_Width: TEdit
Left = 144
Top = 40
Width = 121
Height = 21
TabOrder = 1
Text = 'Edit_Width'
end
object Edit_height: TEdit
Left = 144
Top = 64
Width = 121
Height = 21
TabOrder = 2
Text = 'Edit_Height'
end
object SpinButton_Width: TSpinButton
Left = 272
Top = 38
Width = 20
Height = 25
Hint = 'Double or halven the '#13#10'Width-ratio of resizing'
DownGlyph.Data = {
...........here glyph-data...........................
.....................................................
ParentShowHint = False
ShowHint = True
TabOrder = 3
UpGlyph.Data = {
...........here glyph-data...........................
.....................................................
OnDownClick = SpinButton_WidthDownClick
OnUpClick = SpinButton_WidthUpClick
end
object SpinButton_Height: TSpinButton
Left = 272
Top = 64
Width = 20
Height = 25
Hint = 'Double or halven the '#13#10'Height-ratio of resizing'
DownGlyph.Data = {
...........here glyph-data...........................
.....................................................
ParentShowHint = False
ShowHint = True
TabOrder = 4
UpGlyph.Data = {
...........here glyph-data...........................
.....................................................
OnDownClick = SpinButton_HeightDownClick
OnUpClick = SpinButton_HeightUpClick
end
object CheckBox_KeepAspectRatio: TCheckBox
Left = 160
Top = 16
Width = 169
Height = 17
Caption = '&Keep Aspect-ratio'
Checked = True
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = 'MS Sans Serif'
Font.Style = [fsBold]
ParentFont = False
State = cbChecked
TabOrder = 5
end
object BitBtn_Reset: TBitBtn
Left = 88
Top = 8
Width = 65
Height = 25
Caption = 'Re&set'
TabOrder = 6
OnClick = BitBtn_ResetClick
end
end
object StatusBar1: TStatusBar
Left = 0
Top = 481
Width = 338
Height = 19
Panels = item
Bevel = pbRaised
Text = 'Zooming Images in and out'
Width = 150
end
item
Bevel = pbRaised
Text = 'Dir:\ZoomImageInOut'
Width = 125
end
item
Bevel = pbRaised
Text = '(ent.w.Delphi 5)'
Width = 50
end
SimplePanel = False
end
end
]]>