Selecting different sizes of Images and resize the TDBImage based on Imagesize

Hi,

I have a TDBImage on my form.
When I want to add an image to it I manage that with:

procedure TForm1.ILogoClick(Sender: TObject);
begin
  if OpenPictureDialog1.Execute then
  begin
    DM.TBedrijfsgegevens.Edit;
    ILogo.Picture.LoadFromFile(OpenPictureDialog1.FileName);
  end;
end;

Property Stretch = True

So far so good, but then I see how the image is shown on screen.
When the image doesn't have relatively the same dimensions the image isn't correctly displayed.

1. This is what I want to do:
    Select an image as shown above. Then the dimensions of the TDBImage must be adjusted to the relative size of the loaded image-file.
    Note: The TDBImage must have a maximum size. (otherwise my whole screen will be coverred with the image).

    TDBImage.Height = 100 (=also maximum height)
    TDBImage.width  = 100 (=also maximum width)
    Loading an image of :     Image file size = 200 x 400 pixels

    In order to display the image correctly (stretched) - Based on the image-sizes, the TDBImage must be resized to:
    TDBImage.Height = 50
    TDBImage.width  = 100

    This way I don't need to have demands regarding imagesizes that can be loaded into the program, and still display them well.

2. Set a maximum imagesize for the loaded image. Purely for storage purposes (afterall it is stored in a database).

3. The image can be a BMP, WMF, JPEG or JPG.
    If this complicates it a lot than limit these to JGP and BMP (or even only one of them)

Please supply me with some working sample as I don't have any knowledge regarding images.

Thanks for your help.
Stef
Stef MerlijnDeveloperAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

DragonSlayerCommented:
0
Stef MerlijnDeveloperAuthor Commented:
Oke. The part below is working great for BMP's.
But how about Jpg? Can anybody translate it so it will work for Jpg-files to.
Maybe I have to determine which format the user has loaded.


************* CODE for resizing BMP ****************
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, Buttons;

type
  TForm1 = class(TForm)
    Image1: TImage;
    BitBtn1: TBitBtn;
    procedure FormCreate(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
  private  { Private declarations }
    procedure ResizeImage(Image: TImage; DSize:  Double);
  public   { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  Image1.Picture.LoadFromFile('153_139_ATHENA1.BMP');
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
const
  DSize:  Double = 300;  // DSize determines the size after calculation.
begin
  ResizeImage(Image1, DSize);
end;

procedure TForm1.ResizeImage(Image: TImage; DSize:  Double);
var
  H:      Integer;
  W:      Integer;
  D:      Double;
begin
  D := 1;
  H := Image.Picture.Bitmap.Height;
  W := Image.Picture.Bitmap.Width;
  try
    if ((H>DSize) or (W>DSize)) then
    begin
      Image.Stretch := True;
      if (H>W) then
        D := DSize/H
      else
        D := DSize/W;
    end;
  finally
    Image.Height := Round(D*H);
    Image.Width := Round(D*W);
  end;
end;

end.
0
esoftbgCommented:
uses
  ...., JPEG;

This allow to load *.jpg  

  Image1.Picture.LoadFromFile('153_139_ATHENA1.JPG');
0
Cloud Class® Course: CompTIA Healthcare IT Tech

This course will help prep you to earn the CompTIA Healthcare IT Technician certification showing that you have the knowledge and skills needed to succeed in installing, managing, and troubleshooting IT systems in medical and clinical settings.

Stef MerlijnDeveloperAuthor Commented:
Hi Emil,

Yes, that I know. But how about resizing the image when loaded into the TDBImage. Just like "they" did for me with the BMP in previous mentionedcode.
Will that code accept a JPG-image?

Regards and thanks, Stef
0
Stef MerlijnDeveloperAuthor Commented:
I've tried to load a JPG-file.
The JPG is loaded, but when executing ResizeImage the JPG is cleared from the screen (using the same Dsize).
Any suggestions? Stef
0
Stef MerlijnDeveloperAuthor Commented:
Also I saw a great property on the TImage -> Proportional
That set to True in combination with the Stretch=True is about what I want.
But this property isn't available on TDBImage????
0
esoftbgCommented:
Hi Stef,
Yes, it will work with DBImage ....
Take a look at:
http://experts-exchange.com/Programming/Programming_Languages/Delphi/Q_20951029
http://experts-exchange.com/Programming/Programming_Languages/Delphi/Q_21046446 

I have developed an application, which works with DBImage and InterBase database. It works fine ....
0
Stef MerlijnDeveloperAuthor Commented:
Both pages seem not te be available?? 404 error
0
esoftbgCommented:
I hope I posted these examples at my page, so try
page:        http://www.geocities.com/esoftbg/
  link:        Q_20951029
  link:        Q_21046446
0
Stef MerlijnDeveloperAuthor Commented:
Well I'm sorry,
But both programs seem to have difficulties with JPG-images.
Q_21046446 - Doesn't show the JPG after it is selected. End of game here.
Q_20951029 - When trying to load a JPG-image into the database it doesn't show anything (not even Name of selected file in table).

Back to the drawingtable....... Stef
0
esoftbgCommented:
Sorry, there is really a problem. May be it works only with Interbase database ....
But with interbase I am using the clipboard so may be the clipboard convert .JPG content to .BMP one, I don't know ....
0
Stef MerlijnDeveloperAuthor Commented:
Well on Borland CodeCentral I found a component EDBImage (freeware).
It can manage .ico .bmp .wmf .emf .jpg .jpeg. Without a line of code.
Although I rather not install all kinds of components I'll try this one out and let you know.

Have a nice weekend, Stef
0
esoftbgCommented:
Stef, Have a nice weekend !
I really sorry about the examples ....
Emil
0
esoftbgCommented:
Oooops, about Q_21046446.html : it works correct with .JPG
but must use:
  Image.Picture.Graphic.Height;
  Image.Picture.Graphic.Width;
instead of:
  Image.Picture.Bitmap.Height;
  Image.Picture.Bitmap.Width;

procedure TForm1.ResizeImage(Image: TImage; Percent:  Double);
var
  H:      Integer;
  W:      Integer;
  DSize:  Integer;
  D:      Double;
begin
  D := Percent/100;
  H := Image.Picture.Graphic.Height;
  W := Image.Picture.Graphic.Width;
  Image.Stretch := True;
  Image.Align := alNone;
  try
    if (D<>1) then
    begin
      DSize := Round(H*Percent/100);
      if ((H>DSize) or (W>DSize)) then
      begin
        Image.Stretch := True;
        if (H>W) then
          D := DSize/H
        else
          D := DSize/W;
      end;
    end;
  finally
    Image.Height := Round(D*H);
    Image.Width := Round(D*W);
    if (Image.Width<ScrollBox1.Width) then
    begin
      Image.Left := (ScrollBox1.Width-Image.Width) div 2;
      Image.Top := (ScrollBox1.Height-Image.Height) div 2;
    end
    else
    begin
      Image.Left := 0;
      Image.Top := 0;
    end;
      Position := poDesigned;
    Caption := 'Zoom ' + FloatToStr(Percent) + ' %';
  end;
end;

procedure ImageBestFit(Image: TImage);
var
  H:      Integer;
  W:      Integer;
  IHeight:Integer;
  IWidth: Integer;
  DH:     Double;
  DW:     Double;
  D:      Double;
begin
  D := 1;
  Image.Top := 0;
  Image.Left := 0;
  try
    (Image.Owner as TForm).Align := alClient;
    IHeight := (Image.Parent as TWinControl).Height;
    IWidth := (Image.Parent as TWinControl).Width;
    H := Image.Picture.Graphic.Height;
    W := Image.Picture.Graphic.Width;
    DH := IHeight / H;
    DW := IWidth / W;
    if (H<>IHeight) or (W<>IWidth) then
    begin
      Image.Stretch := True;
      if (DH<DW) then
        D := IHeight/H
      else
        D := IWidth/W;
    end;
  finally
    Image.Height := Round(D*H);
    Image.Width := Round(D*W);
    (Image.Owner as TForm).Caption := 'Zoom ' + FloatToStr(D*100) + ' %';
  end;
end;
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Stef MerlijnDeveloperAuthor Commented:
No problem at all.
Thanks for helping me.
0
esoftbgCommented:
You are welcome
0
Stef MerlijnDeveloperAuthor Commented:
This is indeed perfect.
Thanks a lot Emil.

No I have a great weekend :-)    Stef
0
esoftbgCommented:
I am happy too    :-))    Emil
I love this weekend !
0
Stef MerlijnDeveloperAuthor Commented:
The adjusted code with TDBImage (in stead of TImage).

============= unit code starts here ================
unit Unit1_Q_21046446;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, ToolWin, ComCtrls, Buttons, StdCtrls, Spin, jpeg,
  DBCtrls, DB, DBTables;

type
  TForm1 = class(TForm)
    CoolBar1: TCoolBar;
    SpeedButton200: TSpeedButton;
    SpeedButton50: TSpeedButton;
    SpeedButton100: TSpeedButton;
    SpeedButton800: TSpeedButton;
    SpeedButtonAbove: TSpeedButton;
    SpinEdit1: TSpinEdit;
    ScrollBox1: TScrollBox;
    SpeedButton1: TSpeedButton;
    Image1: TDBImage;
    Table1: TTable;
    DataSource1: TDataSource;
    procedure FormCreate(Sender: TObject);
    procedure SpinEdit1Exit(Sender: TObject);
    procedure SpeedButtonAboveClick(Sender: TObject);
    procedure SpeedButton800Click(Sender: TObject);
    procedure SpeedButton200Click(Sender: TObject);
    procedure SpeedButton100Click(Sender: TObject);
    procedure SpeedButton50Click(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private{ Private declarations }
  public { Public declarations }
    procedure ResizeImage(Image: TDBImage; Percent:  Double);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.ResizeImage(Image: TDBImage; Percent:  Double);
var
  H:      Integer;
  W:      Integer;
  DSize:  Integer;
  D:      Double;
begin
  D := Percent/100;
  H := Image.Picture.Graphic.Height;
  W := Image.Picture.Graphic.Width;
  Image.Stretch := True;
  Image.Align := alNone;
  try
    if (D<>1) then
    begin
      DSize := Round(H*Percent/100);
      if ((H>DSize) or (W>DSize)) then
      begin
        Image.Stretch := True;
        if (H>W) then
          D := DSize/H
        else
          D := DSize/W;
      end;
    end;
  finally
    Image.Height := Round(D*H);
    Image.Width := Round(D*W);
    if (Image.Width<ScrollBox1.Width) then
    begin
      Image.Left := (ScrollBox1.Width-Image.Width) div 2;
      Image.Top := (ScrollBox1.Height-Image.Height) div 2;
    end
    else
    begin
      Image.Left := 0;
      Image.Top := 0;
    end;
      Position := poDesigned;
    Caption := 'Zoom ' + FloatToStr(Percent) + ' %';
  end;
end;

procedure ImageBestFit(Image: TDBImage);
var
  H:      Integer;
  W:      Integer;
  IHeight:Integer;
  IWidth: Integer;
  DH:     Double;
  DW:     Double;
  D:      Double;
begin
  H:=1;
  W:=1;
  D := 1;
  Image.Top := 0;
  Image.Left := 0;
  try
    (Image.Owner as TForm).Align := alClient;
    IHeight := (Image.Parent as TWinControl).Height;
    IWidth := (Image.Parent as TWinControl).Width;
    H := Image.Picture.Graphic.Height;
    W := Image.Picture.Graphic.Width;
    DH := IHeight / H;
    DW := IWidth / W;
    if (H<>IHeight) or (W<>IWidth) then
    begin
      Image.Stretch := True;
      if (DH<DW) then
        D := IHeight/H
      else
        D := IWidth/W;
    end;
  finally
    Image.Height := Round(D*H);
    Image.Width := Round(D*W);
    (Image.Owner as TForm).Caption := 'Zoom ' + FloatToStr(D*100) + ' %';
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Table1.Open;
  ResizeImage(Image1, 100);
end;

procedure TForm1.SpinEdit1Exit(Sender: TObject);
begin
  if (SpinEdit1.Text='') then
    SpinEdit1.Value := 100;
end;

procedure TForm1.SpeedButtonAboveClick(Sender: TObject);
var
  I:      Integer;
  D:      Double;
begin
  if (SpinEdit1.Text='') then
  begin
    SpinEdit1.Value := 100;
    D := SpinEdit1.Value;
  end
  else
  begin
    Val(SpinEdit1.Text, D, I);
    if (I<>0) then
    begin
      SpinEdit1.Value := 100;
      D := SpinEdit1.Value;
    end;
  end;
  ResizeImage(Image1, D);
end;

procedure TForm1.SpeedButton800Click(Sender: TObject);
begin
  ResizeImage(Image1, 800);
end;

procedure TForm1.SpeedButton200Click(Sender: TObject);
begin
  ResizeImage(Image1, 200);
end;

procedure TForm1.SpeedButton100Click(Sender: TObject);
begin
  ResizeImage(Image1, 100);
end;

procedure TForm1.SpeedButton50Click(Sender: TObject);
begin
  ResizeImage(Image1, 50);
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  WindowState := wsMaximized;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  ImageBestFit(Image1);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Table1.Close;
end;

end.
============= unit code ends here ================


==========View form as text (dfm)==============

object Form1: TForm1
  Left = 282
  Top = 147
  BorderIcons = [biSystemMenu, biMinimize]
  BorderStyle = bsSingle
  Caption = 'Zoom %'
  ClientHeight = 578
  ClientWidth = 804
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  Position = poDesktopCenter
  WindowState = wsMaximized
  OnClose = FormClose
  OnCreate = FormCreate
  OnResize = FormResize
  PixelsPerInch = 96
  TextHeight = 13
  object CoolBar1: TCoolBar
    Left = 0
    Top = 0
    Width = 52
    Height = 578
    Align = alLeft
    Bands = <
      item
        Control = SpinEdit1
        ImageIndex = -1
        MinHeight = 52
        Width = 574
      end>
    Vertical = True
    object SpeedButtonAbove: TSpeedButton
      Left = 0
      Top = 31
      Width = 48
      Height = 21
      AllowAllUp = True
      GroupIndex = 1
      Caption = 'Above %'
      OnClick = SpeedButtonAboveClick
    end
    object SpeedButton800: TSpeedButton
      Left = 0
      Top = 53
      Width = 48
      Height = 21
      AllowAllUp = True
      GroupIndex = 1
      Caption = '800 %'
      OnClick = SpeedButton800Click
    end
    object SpeedButton200: TSpeedButton
      Left = 0
      Top = 74
      Width = 48
      Height = 21
      AllowAllUp = True
      GroupIndex = 1
      Caption = '200 %'
      OnClick = SpeedButton200Click
    end
    object SpeedButton100: TSpeedButton
      Left = 0
      Top = 95
      Width = 48
      Height = 21
      AllowAllUp = True
      GroupIndex = 1
      Down = True
      Caption = '100 %'
      OnClick = SpeedButton100Click
    end
    object SpeedButton50: TSpeedButton
      Left = 0
      Top = 116
      Width = 48
      Height = 21
      AllowAllUp = True
      GroupIndex = 1
      Caption = '50 %'
      OnClick = SpeedButton50Click
    end
    object SpeedButton1: TSpeedButton
      Left = 0
      Top = 148
      Width = 48
      Height = 22
      AllowAllUp = True
      GroupIndex = 1
      Caption = 'Best'
      OnClick = SpeedButton1Click
    end
    object SpinEdit1: TSpinEdit
      Left = 0
      Top = 9
      Width = 52
      Height = 23
      AutoSize = False
      Constraints.MaxHeight = 23
      Constraints.MaxWidth = 52
      Constraints.MinHeight = 23
      Constraints.MinWidth = 52
      MaxValue = 0
      MinValue = 0
      TabOrder = 0
      Value = 400
      OnExit = SpinEdit1Exit
    end
  end
  object ScrollBox1: TScrollBox
    Left = 52
    Top = 0
    Width = 752
    Height = 578
    Align = alClient
    TabOrder = 1
    object Image1: TDBImage
      Left = 0
      Top = 0
      Width = 177
      Height = 177
      DataField = 'Graphic'
      DataSource = DataSource1
      TabOrder = 0
    end
  end
  object Table1: TTable
    DatabaseName = 'DBDEMOS'
    TableName = 'biolife.db'
    Left = 332
    Top = 40
  end
  object DataSource1: TDataSource
    DataSet = Table1
    Left = 372
    Top = 40
  end
end

============== end of dmf ===============
0
esoftbgCommented:
Stef, it's really fantastic !
Congratulations !!!!
Emil
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Delphi

From novice to tech pro — start learning today.