Solved

saving a stretched image in the true screen size shown.

Posted on 1998-12-17
13
230 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 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
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
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
 
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

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
When I am typing into a TEdit last word repeats 7 162
Delphi XE10 Round Image 2 193
Magic Software info 18 144
When i run adoquery my application freezes 26 191
A lot of questions regard threads in Delphi.   One of the more specific questions is how to show progress of the thread.   Updating a progressbar from inside a thread is a mistake. A solution to this would be to send a synchronized message to the…
Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
A short tutorial showing how to set up an email signature in Outlook on the Web (previously known as OWA). For free email signatures designs, visit https://www.mail-signatures.com/articles/signature-templates/?sts=6651 If you want to manage em…

726 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