Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

copy a part of a picture to a new file (.BMP or .JPG)

Posted on 1999-08-01
11
Medium Priority
?
212 Views
Last Modified: 2013-11-19
The source files (.BMP or .JPG) are the size 640 X 480 or bigger.  I need to make the picture visible on screen.  So far no problem.  What I need is a peace of the picture copied into a new file (the size has to be 200 X 140).

The questions:
1) Is it possible to place a rectangle on top of the picture (200 X 140) so it can be moved by the mouse to the correct position in to the picture.
2) If question one is answered with yes.  Is it possible to copy the part of the picture inside the rectangle to a new file (.BMP or .JPG).
3) Is it possible to reduce the colors from 24 bits to 8 bits (256 colors), otherwise the size of the file will be to big (.BMP) or is this by .JPG no problem.  The size of the new file has to be arround 30 Kb maximum.  How do I have to do that.

Is it possible to give a little example of the procedures and funtions needed to do this (to select the part of the picture, to save the part into a new file and to reduce the colors if nescesary).

Thanks in advance,
Dirk.

PS Sorry for my poor English.
0
Comment
Question by:ka1a
[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
  • 5
  • 4
  • 2
11 Comments
 
LVL 13

Expert Comment

by:Epsylon
ID: 1392275
1) Sorry, but that will take hours. I have no time for that.
2+3) Take a look at this code:


const x_size = 50;
      y_size = 50;
      x_offset = 100;
      y_offset = 100;
var p: TPicture;
    j: TJPEGImage;
    b: TBitmap;
    src, dest: TRect;
begin
  src := Bounds(x_offset, y_offset, x_size, y_size);
  dest := Bounds(0, 0, x_size, y_size);
  p := TPicture.Create;
  p.LoadFromFile('c:\my documents\pictures\kerstkaart.bmp');
  b := TBitmap.Create;
  b.Width := dest.Right - dest.Left + 1;
  b.Height := dest.Bottom - dest.Top + 1;
  b.Canvas.CopyRect(dest, p.Bitmap.Canvas, src);
  j := TJPEGImage.Create;
  j.Assign(b);
  j.SaveToFile('image.jpg');
  j.Free;
  b.Free;
  p.Free;
end;


Regards,

Epsylon.
0
 

Author Comment

by:ka1a
ID: 1392276
Thanks Epsylon,

How can I get the prommised points to You?

Dirk.
0
 
LVL 27

Accepted Solution

by:
kretzschmar earned 200 total points
ID: 1392277
hi ka1a,

this should do all you want
try it

unit im_copy_u;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;                         //holds Buttons, checkbox & editbox
    ScrollBox1: TScrollBox;                 //holds image1 & Paintbox
    Image1: TImage;                         //Original Image
    CheckBox1: TCheckBox;                   //Toggle Cutting
    Button1: TButton;                       //Load
    Button2: TButton;                       //Save
    OpenPictureDialog1: TOpenPictureDialog; //Open a Picture
    SavePictureDialog1: TSavePictureDialog; //Save a Picture (bmp or jpg)
    PaintBox1: TPaintBox;                   //Shows a focusrect
    Button3: TButton;                       //Setup Cut Rect
    Edit1: TEdit;                           //Width of Cutting
    Edit2: TEdit;                           //Height of Cutting
    Splitter1: TSplitter;                   //Split Scrollbox1 & Scrollbox2
    ScrollBox2: TScrollBox;                 //Holds Image2
    Image2: TImage;                         //Cutted Image
    procedure Button1Click(Sender: TObject);
    procedure PaintBox1Paint(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button2Click(Sender: TObject);
  private
    Procedure Snap;
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

var xx, yy : Integer;

//Do Cut
Procedure TForm1.Snap;
var R1, R2 : TRect;
begin
  R1 := Rect(PaintBox1.Left,PaintBox1.Top,
            PaintBox1.Left+PaintBox1.Width,
            PaintBox1.Top+PaintBox1.Height);
  R2 := Rect(Image1.Left,Image1.Top,
            Image1.Left+Image1.Width,
            Image1.Top+Image1.Height);
  if (R1.Left >= R2.Left) and
     (R1.top >= R2.Top) and
     (R1.Right <= R2.Right) and
     (R1.Bottom <= R2.Bottom) then
  begin
    R1.Left := Abs(R2.Left-R1.Left);
    R1.Right := Abs(R2.Left-R1.Right);
    R1.Top := Abs(R2.Top-R1.Top);
    R1.Bottom := Abs(R2.Top-R1.Bottom);
    Image2.Canvas.CopyRect(PaintBox1.ClientRect,image1.Canvas,R1);
  end;
end;

//Do Load
procedure TForm1.Button1Click(Sender: TObject);
begin
  If openpicturedialog1.Execute then
    Image1.Picture.LoadFromFile(openpicturedialog1.FileName);
end;

//Draw Cutting Rect
procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
  Paintbox1.Canvas.DrawFocusRect(Paintbox1.ClientRect);
end;

//Adjust Cutting Metrics
procedure TForm1.Button3Click(Sender: TObject);
begin
  PaintBox1.Width := StrtoInt(edit1.text);
  PaintBox1.height := StrtoInt(edit2.text);
  Image2.Width := StrtoInt(edit1.text);
  Image2.Height := StrtoInt(edit2.text);
end;

//Prepare for drag Cutting-Area
procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  xx := x;
  yy := y;
end;

//Drag Cutting-Area and Cut if toggled on
procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if ssleft in shift then
  begin
    paintbox1.Top := paintbox1.Top + y - yy;
    paintbox1.Left := paintbox1.Left + x - xx;
    If CheckBox1.Checked then Snap;
  end;
end;

//Init
procedure TForm1.FormCreate(Sender: TObject);
begin
  Edit1.Text := '200';
  Edit2.Text := '140';
  Button3.Click;
end;

//Cut if toggled on
procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  If CheckBox1.Checked then Snap;
end;

//Save and reduce to 256 Colors
procedure TForm1.Button2Click(Sender: TObject);
var
  J : TJpegImage;
begin
  if Image2.Picture <> nil then
    if SavePictureDialog1.Execute then
    begin
      J := TJPegImage.Create;
      J.PixelFormat := jf8Bit;
      try
        case SavePictureDialog1.FilterIndex of
          1 : Begin
                J.Assign(Image2.Picture.Bitmap);
                Image2.Picture.Bitmap.Assign(J);
                Image2.Picture.Bitmap.SaveToFile(SavePictureDialog1.FileName+'.bmp');
              end;
          2 : Begin
                J.Assign(Image2.Picture.Bitmap);
                J.SaveToFile(SavePictureDialog1.FileName+'.jpg');
              end;
          else Showmessage('No Format selected');
        end;
      finally
        J.Free;
      end;
    end;
end;

end.

meikl
0
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 
LVL 27

Expert Comment

by:kretzschmar
ID: 1392278
oops eps, sorry, didn't see your comment ;-)
0
 
LVL 13

Expert Comment

by:Epsylon
ID: 1392279
Never mind   :o)
0
 

Author Comment

by:ka1a
ID: 1392280
Meikl,

I just tried youre unit.

I can select a picture (.BMP or .JPG).  Yhe picture becomes visible in image1.

There is a rectange visible.  I can move it with the mouse.

But in image2 there becomes nothing visible.  When push the save button an empty .BMP file is saved.  There are no errormessages.

What am I doing wrong.  I copied your text so I didn't make any type errors.

Any suggestions.

Thanks,
Dirk.
0
 
LVL 27

Expert Comment

by:kretzschmar
ID: 1392281
hi dirk,

there is a checkbox, if the checkbox checked then the cutting is active by the mouseevent of the rectangle (PaintBox).

hope thats it ;-)

meikl
0
 

Author Comment

by:ka1a
ID: 1392282
Meikl,

If the checkbox is checked or not, it makes no difference.

If you must find out what other reason it could be, please let me now.

Thanks,
Dirk.

PS Is it possible that I did make a mistake by constructing the Form? (A component on the wrong parrent or somthing like that?)
0
 
LVL 27

Expert Comment

by:kretzschmar
ID: 1392283
hi ka1a,

here is the form as text, leave your email here, then i send you the little project

object Form1: TForm1
  Left = 200
  Top = 102
  Width = 544
  Height = 375
  Caption = 'Form1'
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Splitter1: TSplitter
    Left = 249
    Top = 73
    Width = 3
    Height = 278
    Cursor = crHSplit
  end
  object Panel1: TPanel
    Left = 0
    Top = 0
    Width = 536
    Height = 73
    Align = alTop
    Caption = 'Panel1'
    TabOrder = 0
    object CheckBox1: TCheckBox
      Left = 336
      Top = 8
      Width = 97
      Height = 17
      Caption = 'CheckBox1'
      TabOrder = 0
    end
    object Button1: TButton
      Left = 24
      Top = 8
      Width = 75
      Height = 25
      Caption = 'Button1'
      TabOrder = 1
      OnClick = Button1Click
    end
    object Button2: TButton
      Left = 112
      Top = 8
      Width = 75
      Height = 25
      Caption = 'Button2'
      TabOrder = 2
      OnClick = Button2Click
    end
    object Button3: TButton
      Left = 304
      Top = 40
      Width = 75
      Height = 25
      Caption = 'Button3'
      TabOrder = 3
      OnClick = Button3Click
    end
    object Edit1: TEdit
      Left = 392
      Top = 24
      Width = 121
      Height = 21
      TabOrder = 4
      Text = 'Edit1'
    end
    object Edit2: TEdit
      Left = 392
      Top = 48
      Width = 121
      Height = 21
      TabOrder = 5
      Text = 'Edit2'
    end
  end
  object ScrollBox1: TScrollBox
    Left = 0
    Top = 73
    Width = 249
    Height = 278
    Align = alLeft
    TabOrder = 1
    object Image1: TImage
      Left = 0
      Top = 0
      Width = 105
      Height = 105
      AutoSize = True
    end
    object PaintBox1: TPaintBox
      Left = 120
      Top = 32
      Width = 105
      Height = 105
      OnMouseDown = PaintBox1MouseDown
      OnMouseMove = PaintBox1MouseMove
      OnMouseUp = PaintBox1MouseUp
      OnPaint = PaintBox1Paint
    end
  end
  object ScrollBox2: TScrollBox
    Left = 252
    Top = 73
    Width = 284
    Height = 278
    Align = alClient
    TabOrder = 2
    object Image2: TImage
      Left = 0
      Top = 0
      Width = 280
      Height = 274
      AutoSize = True
      Center = True
    end
  end
  object OpenPictureDialog1: TOpenPictureDialog
    Filter = 'Bitmaps (*.bmp)|*.bmp|JPG (*.jpg)|*.jpg'
    Left = 216
    Top = 16
  end
  object SavePictureDialog1: TSavePictureDialog
    Filter = 'Bitmaps (*.bmp)|*.bmp|JPeg (*.jpg)|*.jpg'
    Left = 264
    Top = 24
  end
end

meikl
0
 

Author Comment

by:ka1a
ID: 1392284
Meikl,

Please send the project to:

    dirk.peeters@glo.be

Thanks,
Dirk.

PS: You realy save my day with this one, thanks again.
0
 
LVL 27

Expert Comment

by:kretzschmar
ID: 1392285
is sent just now ;-)
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

This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
In this tutorial I will show you how to use the Windows Speech API in Delphi. I will only cover basic functions such as text to speech and controlling the speed of the speech. SAPI Installation First you need to install the SAPI type library, th…
Add visuals to your Prezi to keep your audience engaged. Learn how to embed images, edit them, and more in this video micro tutorial. Select "Insert" from the top menu in your Prezi editor: Select "Image": A toolbar will pop in from the right …
Not only does Prezi allow you to create non-linear presentations, it also makes it easy to apply transition animations between your frames. Learn how to apply a fade-in transition to select items and entire frames in this tutorial Select "Edit Path"…
Suggested Courses

704 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