Solved

saving a stretched image in the true screen size shown.

Posted on 1998-12-17
13
227 Views
Last Modified: 2010-04-04
I am using D4. I need to resize a picture during runtime and save that picture in that screen size. While stretch  does this visually on the screen, I cannot save the new resized image in the screen view size. For comparison, if I were to use the editor in windows95 Paint program, I can Stretch and Skew and then Save the image/picture to a new name/size. I would like to this during the run time of my D4 program. Coding of the openDialog,saveDialog pose no problem, but saving the exact resized picture does.

Delphi3
0
Comment
Question by:delphi3
  • 6
  • 5
  • 2
13 Comments
 
LVL 4

Author Comment

by:delphi3
ID: 1351549
Edited text of question
0
 
LVL 20

Expert Comment

by:Madshi
ID: 1351550
I have not test it, but try this:

procedure StretchImage(oldImg,newImg: TImage);
begin
  newImg.width:=Screen.Width; newImg.height:=Screen.Height;
  newImg.picture.bitmap.width:=Screen.Width; newImg.picture.bitmap.height:=Screen.Height;
  newImg.picture.bitmap.canvas.StretchDraw(Rect(0,0,Screen.Width,Screen.Height),oldImg);
end;

Regards... Madshi.
0
 
LVL 3

Expert Comment

by:philipleighs
ID: 1351551
Madshi,
I don't get the screen.width/height parts.

delphi3,

function ZoomBitmap(Src: TBitmap; ZoomFactor: Double): TBitmap
begin
  Result := TBitmap.Create;
  Result.PixelDepth := Src.PixelDepth;
  Result.Palette := Src.Palette;
  Result.Width := Round(Src.Width * ZoomFactor);
  Result.Height := Round(Src.Height * ZoomFactor);
  Result.Canvas.StretchDraw(
          Rect(0, 0, Result.Width, Result.Height),
          Src);
end;

I've not compiled this either, so apologies if it doesn't work.
0
 
LVL 3

Expert Comment

by:philipleighs
ID: 1351552
Whoops, I see I'm missing a semicolon
0
 
LVL 20

Expert Comment

by:Madshi
ID: 1351553
Hi Philip,
delphi3 wanted the bitmap to be resized to screen size. That's why I used Screen.Width/Height.

Delphi3,
probably you should combine Philip's and my sources. I didn't look at the pixelDepth and the palette...

Regards... Madshi.
0
 
LVL 4

Author Comment

by:delphi3
ID: 1351554
Hi Madshi and Philipleighs,
I want to award the points to one of you, if you will claim your comment  as a solution.  I too, have a solution  to share but only after your solution is presented or someone else does. Otherwise, I will delete the question by Monday 12PM PST.
Thanks.
Delphi3
0
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 
LVL 20

Expert Comment

by:Madshi
ID: 1351555
Hmmm. Did Phillip's or my comment help you? If yes, tell us which helped more. If not, then delete the question.

Regards... Madshi.
0
 
LVL 4

Author Comment

by:delphi3
ID: 1351556
Madshi,
This is like grading papers in school..... Mathematics Exams. Equal credit for nearly equivalent solutions but not complete. This kind of scoring is not possible in this game. It's winner take all.
 
Since you responded first but not in the manner you are suppsed to then do it , submit your comment  on the solution form and the points are yours.

Delphi3
0
 
LVL 20

Accepted Solution

by:
Madshi earned 50 total points
ID: 1351557
Thanx for the points...  :-)

Regards, Madshi.
0
 
LVL 4

Author Comment

by:delphi3
ID: 1351558
unit ZoomBitmapUnit1;

interface

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

type
  TForm1 = class(TForm)
    Image1: TImage;
    Image2: TImage;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Save1: TMenuItem;
    Open1: TMenuItem;
    Exit1: TMenuItem;
    Edit1: TEdit;
    Label1: TLabel;
    procedure Open1Click(Sender: TObject);
    procedure Save1Click(Sender: TObject);
    function ZoomBitmap(Img1: TBitmap; ZoomFactor:Real;Sender: TObject): TBitmap;
    procedure Exit1Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    function NoValue (AnEditBox: TEdit;Sender: TObject): Boolean;
 
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

function TForm1.NoValue (AnEditBox: TEdit; Sender: TObject): Boolean;
 begin
  if AnEditBox.Text = ''   then
  begin
    AnEditBox.Color := clYellow;
    AnEditBox.Text := 'Enter a Number';
    Result := True;
    end
   else
    begin
     AnEditBox.Color := clWindow;
     Result := False;
    end;
end;
                                                
function TForm1.ZoomBitmap(Img1: TBitmap; ZoomFactor:Real;Sender: TObject): TBitmap;

  begin
    Result := TBitmap.Create;
    //Result.PixelDepth := Img1.PixelDepth; Didn't work
    Result.Palette := Img1.Palette;
    Result.Width := Round(Img1.Width * ZoomFactor);
    Result.Height := Round(Img1.Height * ZoomFactor);
    Result.Canvas.StretchDraw(Rect(0,0,Result.Width, Result.Height),Img1);
 end;

procedure TForm1.Open1Click(Sender: TObject);
  var
 NewBitmap: TBitmap;
 Zfactr:real;
 begin
  if NoValue(Edit1, Self) then       {If an edit box is empty highlight it}
    begin
    end
  else
    begin
   if OpenDialog1.Execute then
    begin
      Zfactr := StrToFloat(Edit1.Text);
      Image1.stretch := true;
      Image1.Picture.LoadFromFile(OpenDialog1.FileName);
      Refresh;
      NewBitmap := TBitmap.Create;
      NewBitmap.Width := Image1.Picture.Width ;
      NewBitmap.Height := Image1.Picture.Height;
      NewBitmap.Assign(Image1.Picture.Graphic);
      Refresh;
      Image2.Width := Round(Image1.Picture.Width * Zfactr);
      Image2.Height := Round(Image1.Picture.Height * Zfactr);
      Image2.Picture.graphic := ZoomBitmap(NewBitmap,Zfactr,Self);
      Refresh;
   end;
  end;
end;

procedure TForm1.Save1Click(Sender: TObject);
begin
 if SaveDialog1.Execute then
    Begin  {Had to add the .bmp to identify the file type}
      Image2.Picture.SaveToFile(SaveDialog1.FileName + '.bmp');
   end;
end;

procedure TForm1.Exit1Click(Sender: TObject);
 begin
  Application.Terminate;
 end;

procedure TForm1.FormActivate(Sender: TObject);
 begin
  Edit1.Text:= '';
 end;

end.

// form1 written in text follows:

object Image1: TImage
  Left = 16
  Top = 120
  Width = 105
  Height = 105
end
object Image2: TImage
  Left = 176
  Top = 120
  Width = 105
  Height = 105
end
object Label1: TLabel
  Left = 24
  Top = 64
  Width = 269
  Height = 16
  Caption = 'Enter Enlargement  Factor   Any Real Number'
end
object Edit1: TEdit
  Left = 96
  Top = 88
  Width = 121
  Height = 24
  TabOrder = 0
  Text = 'Edit1'
end
object OpenDialog1: TOpenDialog
  Left = 344
  Top = 72
end
object SaveDialog1: TSaveDialog
  Left = 344
  Top = 16
end
object MainMenu1: TMainMenu
  Left = 344
  Top = 125
  object File1: TMenuItem
    Caption = '&File'
    object Save1: TMenuItem
      Caption = '&Save'
      OnClick = Save1Click
    end
    object Open1: TMenuItem
      Caption = '&Open'
      OnClick = Open1Click
    end
    object Exit1: TMenuItem
      Caption = 'E&xit'
      OnClick = Exit1Click
    end
  end
end

0
 
LVL 20

Expert Comment

by:Madshi
ID: 1351559
Looks fine. However, you should un-comment the line with the pixelDepth. It didn't work, because the property is named "pixelFormat" instead of "pixelDepth". If you change the name, it should work fine.

Regards, Madshi.
0
 
LVL 4

Author Comment

by:delphi3
ID: 1351560
Madshi,
Thanks for the correction.  

Delphi3
0
 
LVL 20

Expert Comment

by:Madshi
ID: 1351561
No problem...
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
automatically logging in via bde delphi 3 69
proper way to parse url in delphi 2 163
Delphi cmd execution 6 55
Delphi Firemonkey Need Sample for Online Shopping Example. 2 120
Objective: - This article will help user in how to convert their numeric value become words. How to use 1. You can copy this code in your Unit as function 2. than you can perform your function by type this code The Code   (CODE) The Im…
Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have to…
Internet Business Fax to Email Made Easy - With eFax Corporate (http://www.enterprise.efax.com), you'll receive a dedicated online fax number, which is used the same way as a typical analog fax number. You'll receive secure faxes in your email, fr…
Many functions in Excel can make decisions. The most simple of these is the IF function: it returns a value depending on whether a condition you describe is true or false. Once you get the hang of using the IF function, you will find it easier to us…

911 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

16 Experts available now in Live!

Get 1:1 Help Now