Solved

saving a stretched image in the true screen size shown.

Posted on 1998-12-17
13
229 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
Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

 
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

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

Question has a verified solution.

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

Suggested Solutions

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 The parallel port is a very commonly known port, it was widely used to connect a printer to the PC, if you look at the back of your computer, for those who don't have newer computers, there will be a port with 25 pins and a small print…
In a recent question (https://www.experts-exchange.com/questions/29004105/Run-AutoHotkey-script-directly-from-Notepad.html) here at Experts Exchange, a member asked how to run an AutoHotkey script (.AHK) directly from Notepad++ (aka NPP). This video…
In an interesting question (https://www.experts-exchange.com/questions/29008360/) here at Experts Exchange, a member asked how to split a single image into multiple images. The primary usage for this is to place many photographs on a flatbed scanner…

856 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