Solved

saving a stretched image in the true screen size shown.

Posted on 1998-12-17
13
226 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
Comment Utility
Edited text of question
0
 
LVL 20

Expert Comment

by:Madshi
Comment Utility
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
Comment Utility
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
Comment Utility
Whoops, I see I'm missing a semicolon
0
 
LVL 20

Expert Comment

by:Madshi
Comment Utility
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
Comment Utility
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
Do You Know the 4 Main Threat Actor Types?

Do you know the main threat actor types? Most attackers fall into one of four categories, each with their own favored tactics, techniques, and procedures.

 
LVL 20

Expert Comment

by:Madshi
Comment Utility
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
Comment Utility
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
Comment Utility
Thanx for the points...  :-)

Regards, Madshi.
0
 
LVL 4

Author Comment

by:delphi3
Comment Utility
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
Comment Utility
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
Comment Utility
Madshi,
Thanks for the correction.  

Delphi3
0
 
LVL 20

Expert Comment

by:Madshi
Comment Utility
No problem...
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

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…
Have you ever had your Delphi form/application just hanging while waiting for data to load? This is the article to read if you want to learn some things about adding threads for data loading in the background. First, I'll setup a general applica…
Sending a Secure fax is easy with eFax Corporate (http://www.enterprise.efax.com). First, Just open a new email message.  In the To field, type your recipient's fax number @efaxsend.com. You can even send a secure international fax — just include t…
Polish reports in Access so they look terrific. Take yourself to another level. Equations, Back Color, Alternate Back Color. Write easy VBA Code. Tighten space to use less pages. Launch report from a menu, considering criteria only when it is filled…

762 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

9 Experts available now in Live!

Get 1:1 Help Now