saving a stretched image in the true screen size shown.

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
LVL 4
delphi3Asked:
Who is Participating?
 
MadshiConnect With a Mentor Commented:
Thanx for the points...  :-)

Regards, Madshi.
0
 
delphi3Author Commented:
Edited text of question
0
 
MadshiCommented:
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
The 14th Annual Expert Award Winners

The results are in! Meet the top members of our 2017 Expert Awards. Congratulations to all who qualified!

 
philipleighsCommented:
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
 
philipleighsCommented:
Whoops, I see I'm missing a semicolon
0
 
MadshiCommented:
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
 
delphi3Author Commented:
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
 
MadshiCommented:
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
 
delphi3Author Commented:
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
 
delphi3Author Commented:
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
 
MadshiCommented:
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
 
delphi3Author Commented:
Madshi,
Thanks for the correction.  

Delphi3
0
 
MadshiCommented:
No problem...
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.