دمج الصور

اخي العزيز

مع اني لم افهم المقصود تماما لكن ساعطيك البرنامج التالي الدي يقوم بتكوين صورتين واحدة امامية و الاخري كخلفية لها ,

حيت الصورة الاولى اسمها h1 وهي الخلفية للصورة التانية H2 حيت يشرط في الصورة التانية H2 ان تحتوي على صورة اصغر من الصورة H1

وتكون دات خلفية بيضا ,

ضع الاوامر التالية داخل FORM جديدة , و ما عليك فقط الا ان تقوم ب

1- ربط احدت oncreate الخاص بالفورم

2- ضع صورتين في نفس الدليل الدي كونت به البرنامج و سمهم h1 , h2 .

فقط وسوف يشتغل الكود بادن الله

unit Unit1;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, ExtCtrls;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
  public
  ImageForeGround: TImage;
    ImageBackGround: TImage;
    { Public declarations }
  end;

procedure DrawTransparentBitmap (ahdc: HDC;
                                 Image: TImage;
                                 xStart, yStart: Word);

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure DrawTransparentBitmap (ahdc: HDC;
                                 Image: TImage;
                                 xStart, yStart: Word);
var
  TransparentColor: TColor;
  cColor          : TColorRef;
  bmAndBack,
  bmAndObject,
  bmAndMem,
  bmSave,
  bmBackOld,
  bmObjectOld,
  bmMemOld,
  bmSaveOld       : HBitmap;
  hdcMem,
  hdcBack,
  hdcObject,
  hdcTemp,
  hdcSave         : HDC;
  ptSize          : TPoint;
begin
{ set the transparent color to be the lower left pixel of the bitmap
}
TransparentColor := Image.Picture.Bitmap.Canvas.Pixels[0,
  Image.Height - 1];
TransparentColor := TransparentColor or $02000000;

hdcTemp := CreateCompatibleDC (ahdc);
SelectObject (hdcTemp, Image.Picture.Bitmap.Handle); { select the bitmap }

{ convert bitmap dimensions from device to logical points
}
ptSize.x := Image.Width;
ptSize.y := Image.Height;
DPtoLP (hdcTemp, ptSize, 1);  { convert from device logical points }

{ create some DCs to hold temporary data
}
hdcBack   := CreateCompatibleDC(ahdc);
hdcObject := CreateCompatibleDC(ahdc);
hdcMem    := CreateCompatibleDC(ahdc);
hdcSave   := CreateCompatibleDC(ahdc);

{ create a bitmap for each DC
}

{ monochrome DC
}
bmAndBack   := CreateBitmap (ptSize.x, ptSize.y, 1, 1, nil);
bmAndObject := CreateBitmap (ptSize.x, ptSize.y, 1, 1, nil);

bmAndMem    := CreateCompatibleBitmap (ahdc, ptSize.x, ptSize.y);
bmSave      := CreateCompatibleBitmap (ahdc, ptSize.x, ptSize.y);

{ each DC must select a bitmap object to store pixel data
}
bmBackOld   := SelectObject (hdcBack, bmAndBack);
bmObjectOld := SelectObject (hdcObject, bmAndObject);
bmMemOld    := SelectObject (hdcMem, bmAndMem);
bmSaveOld   := SelectObject (hdcSave, bmSave);

{ set proper mapping mode
}
SetMapMode (hdcTemp, GetMapMode (ahdc));

{ save the bitmap sent here, because it will be overwritten
}
BitBlt (hdcSave, 0, 0, ptSize.x, ptSize.y, hdcTemp, 0, 0, SRCCOPY);

{ set the background color of the source DC to the color.
  contained in the parts of the bitmap that should be transparent
}
cColor := SetBkColor (hdcTemp, TransparentColor);

{ create the object mask for the bitmap by performing a BitBlt()
  from the source bitmap to a monochrome bitmap
}
BitBlt (hdcObject, 0, 0, ptSize.x, ptSize.y, hdcTemp, 0, 0, SRCCOPY);

{ set the background color of the source DC back to the original color
}
SetBkColor (hdcTemp, cColor);

{ create the inverse of the object mask
}
BitBlt (hdcBack, 0, 0, ptSize.x, ptSize.y, hdcObject, 0, 0, NOTSRCCOPY);

{ copy the background of the main DC to the destination
}
BitBlt (hdcMem, 0, 0, ptSize.x, ptSize.y, ahdc, xStart, yStart, SRCCOPY);

{ mask out the places where the bitmap will be placed
}
BitBlt (hdcMem, 0, 0, ptSize.x, ptSize.y, hdcObject, 0, 0, SRCAND);

{ mask out the transparent colored pixels on the bitmap
}
BitBlt (hdcTemp, 0, 0, ptSize.x, ptSize.y, hdcBack, 0, 0, SRCAND);

{ XOR the bitmap with the background on the destination DC
}
BitBlt (hdcMem, 0, 0, ptSize.x, ptSize.y, hdcTemp, 0, 0, SRCPAINT);

{ copy the destination to the screen
}
BitBlt (ahdc, xStart, yStart, ptSize.x, ptSize.y, hdcMem, 0, 0, SRCCOPY);

{ place the original bitmap back into the bitmap sent here
}
BitBlt (hdcTemp, 0, 0, ptSize.x, ptSize.y, hdcSave, 0, 0, SRCCOPY);

{ delete the memory bitmaps
}
DeleteObject (SelectObject (hdcBack, bmBackOld));
DeleteObject (SelectObject (hdcObject, bmObjectOld));
DeleteObject (SelectObject (hdcMem, bmMemOld));
DeleteObject (SelectObject (hdcSave, bmSaveOld));

{ delete the memory DCs
}
DeleteDC (hdcMem);
DeleteDC (hdcBack);
DeleteDC (hdcObject);
DeleteDC (hdcSave);
DeleteDC (hdcTemp);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
{ create image controls for two bitmaps and set their parents
}
ImageForeGround := TImage.Create (Form1);
ImageForeGround.Parent := Form1;
ImageBackGround := TImage.Create (Form1);
ImageBackGround.Parent := Form1;

{ load images
}
ImageBackGround.Picture.LoadFromFile ('h1.bmp');
ImageForeGround.Picture.LoadFromFile ('h2.bmp');

{ set background image size to its bitmap dimensions
}
with ImageBackGround do
  begin
  Left := 0;
  Top := 0;
  Width := Picture.Width;
  Height := Picture.Height;
  end;

{ set the foreground image size centered in the background image
}
with ImageForeGround do
  begin
  Left := (ImageBackGround.Picture.Width - Picture.Width) div 2;
  Top := (ImageBackGround.Picture.Height - Picture.Height) div 2;
  Width := Picture.Width;
  Height := Picture.Height;
  end;

{ do not show the transparent bitmap as it will be displayed (BitBlt()ed)
  by the DrawTransparentBitmap() function
}
ImageForeGround.Visible := False;

{ draw the tranparent bitmap
  note how the DC of the foreground is used in the function below
}
DrawTransparentBitmap (ImageBackGround.Picture.Bitmap.Canvas.Handle, {HDC}
                       ImageForeGround, {TImage}
                       ImageForeGround.Left, {X}
                       ImageForeGround.Top {Y} );
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
{ free images
}
ImageForeGround.Free;
ImageBackGround.Free;
end;

end.

وشكرا

لقد قمت بتعديل الكود ليظهر بصورة صحيحة ولم أغير فيه أى شيئ (((رمضان)))

شكرا لك يا أخ Madi

بصراحة أنا أقوم ببناء برنامج رسم لة مواصفات معينة وهو شبية نوعا ما ببرامج الهواتف الخلوية التي تصنع Logo

والمشكلة الأهم في الموضوع هو الرسم في وضع التكبير Zoom أرجو أن اكون قد وضحت الفكرة

مرحبا لقد تمت جميع العمليات بنجاح ما عدى الرسم على اللوحة في وضعيت الزوم

فهل لدى أحدكم أي فكرة ممكن يفيدني بها

(f)

hello,

I think you need to deal with BitBlt() API function, and you can

find an explanasion about it in MSDN or API help file which come with Delphi.

thanks

ياريت يا اخي العزيز توطح المطلوب اكتر , وياريت توضح العمليات التي تمت بنجاح لكي يستفيد منها الجميع و ايضا لكي نفهم نحن البرنامج فنستطيع التوضيح اكتر .

وشكرا

البرامج مبنية ب دلفي 6

هذا هو أول برنامج

http://toffi.4t.com/Draw/Drawing.zip

هذا هو الثاني

http://toffi.4t.com/Draw/drawing%201.zip

هذا هو البرنامج اللذي اريد أن اضيف امكانيات الرسم الموجودة به على برنامجي

http://toffi.4t.com/Draw/toffi.zip

يبدو انو ما حدا لحدا هي الأيام

السلام عليكم

الاخ عبد القادر

لا يأس مع الحياة و لا حياة مع اليأس .

أخي الفترة فترة اختبارات و الاخوة اغلبهم مشغول .:)

اود ان اساعد - ان استطعت ذلك- لكن لم استطع تنزيل البرامج التي وضعتها(حاولت عدة مرات) . تأكد من الارتباطات ;)

اخي العزيز

لاسف الوصلات ما اشتغلت , كنت فاكر ان المشكلة من عندي لاني كنت اعاني شوية مشاكل في الانترنت ( بطء كبير لدرجة الغليان) .

لكن الباين المشكلة من الوصلة , حاول مرة تانية وان شا الله تعالى كلنا حنساعدك .

وشكرا

الوصلات شغالة من عندي وأنا عيطي هي الصلاحية من خلال غرفت التحكم في الموقع على كل حال جربتو الضغط بزر الماوس الأيمن على الوصلة واختيار حفظ اهدف

اذا ما شتغلو ياريت تخبروني

السلام عليكم

اخي الكريم

نحن نعلم كيف نقوم بعملية download :). المشكلة في الوصلات فعلا .

الم تلاحظ ان الصور التي عملت لها ارتباط هنا لا تظهر مثل

http://toffi.4t.com/Draw/1.jpg

اخي الكريم تاكد من الوصلات :) . منتظرين علــى نار (حتى ما تقول يبدو انو ما حدا لحدا هي الأيام :confused: :confused: :confused: ).

اخي العزيز , نحن لم نتاخر عليك , لكن المطلوب غير واضح ,

عموما اليك هده الطريقة لتكبير و تصغير الصور مع متال لطريقة استخدامها . ضع Image و زر على الفروم , حمل صورة داخل Image

واكتب الكود التالي .

procedure ResizePicture(Mainp:Timage;xmax,ymax:integer);

    var MainpX,MainpY,FormY,FormX,a,b,Faktor:Real;

    begin

    mainp.stretch := False;

    mainp.autosize := True;

    mainp.stretch := true;

    mainp.autosize := false;

    a := mainp.Width / xmax;

    b := mainp.Height / ymax;

    MainpX := Mainp.width;

    MainpY := Mainp.height;

    FormX := xmax;

    FormY := ymax;

    If a >= b Then

    Begin

    faktor := mainpX / FormX;

    mainpX := FormX;

    mainpY := mainpY / faktor;

    End;

    If a < b Then

    Begin

    Faktor := mainpY / FormY;

    mainpY := FormY;

    mainpX := mainpX / faktor;

    End;

    Mainp.width:=Trunc(MainpX);

    Mainp.height:=Trunc(MainpY);

    end;





procedure TForm1.Button1Click(Sender: TObject);

begin

ResizePicture(image1,100,100);

end;

وشكرا

http://www.toffi.4t.com/Draw/drawing.htm

وهذا عنوان الموقع الأصلي للبرنامج

هنا

اخي العزيز للاسف , لم ينزل البرنامج , ويطلب في اسم مستخدم وكلمة سر .

ياريت اخي العزيز تشرح بالتفصيل الممل المطلوب في برنامجك , وتحاول تعديل الوصلة او تحاول تحميل الملف في مكان اخر متلا أين

وشكرا

مــــMADIــــدي

شكرا لكم جميعا أخواني الكرام

وأخص بالشكر الاستاذ عبد الودود مرعشي (f)

أخي عبد القادر

لا شكر على واجب

ولكن إذا ما عندك مانع أن تضع الفكرة النهائية في المنتدى لتعم الفائدة على الجميع

والسلام عليكم

:o

الفكرة ببساطة أننا قمنا بوضع هداة Image عدد 2 الأولى بالحجم الأصلي وهو صغير بوعا ما والثانية بالحجم المضاعف وكانت نسبت التكبير لدي هي ثمانية مرات

عند عملية الرسم على الصورة الثانية طبعا في الحدث "ماوس موف" نرسم على الصوره الأولى بنفس الأحداثيات ولكن تقسيم 8 وبعد ذالك نمسح الصوره الثانية ونجعاها تأخذ صورتها من الصورة الأولى عبر التابع

StretchBlt (image2.Canvas.Handle,0,0,576,256,image1.Canvas.Handle,0,0,72,32,$CC0020);

وغن شاء الله بكون كلي شيء تمام

أخي العزيز , وجدت لك هدا الكود الدي قد يفيدك .

فقط ضع Image على الفورم سمه Display .

تم ستحتاج الى المتغيرات الخارجية

 

var

 	 Form1: TForm1;

	LastX,LastY:Integer;

const

	ZOOM_RECT=30;

    DoZoomIn:Boolean=False;

وايضا سوف تحتاج للتعامل مع الاحدات التالية

FormCreate الخاص بالفورم

DisplayMouseMove الخاص با Image

DisplayMouseUp الخاص با Image

وستحتاج الى تعريف الاجراء

DrawMandelbrot

الان اليك الكود كاملا

 





interface



uses

	Graphics, Forms, ExtCtrls, Controls, Classes,

    MandelbrotExplorerProcs;



type

  TForm1 = class(TForm)

    Display: TImage;

    procedure FormCreate(Sender: TObject);

    procedure ResetDisplay;

    procedure DrawMandelbrot;

    procedure DisplayMouseMove(Sender: TObject; Shift: TShiftState; X,

      Y: Integer);

    procedure DisplayMouseUp(Sender: TObject; Button: TMouseButton;

      Shift: TShiftState; X, Y: Integer);

  private

    { Private declarations }

  public

    { Public declarations }

  end;



var

 	 Form1: TForm1;

	LastX,LastY:Integer;

const

	ZOOM_RECT=30;

    DoZoomIn:Boolean=False;



implementation



{$R *.DFM}







procedure TForm1.FormCreate(Sender: TObject);

begin

{Initialize scaling}

    DisplayWidth:=Display.Width;

    DisplayHeight:=Display.Height;

    MinX:=-2.2; MaxX:=0.5;

    MinY:=-1.35;  MaxY:=1.35;

    Rescale;

{Reset Display}

    ResetDisplay;

{Reset the palette}

   FillChar(MandelbrotPalette,SizeOf(MandelbrotPalette),0);

  MandelbrotPalette[MB_MAX]:=clWhite;

end;



procedure TForm1.ResetDisplay;

begin

  with Display.Canvas do begin

   	 Brush.Color:=clBlack;

        Brush.Style:=bsSolid;

        FillRect(Display.ClientRect);

    end;

	Display.Refresh;

end;



procedure TForm1.DrawMandelbrot;

var i,j,C:Integer;

	X,Y:Real;

begin

	if DoZoomIn then Exit;

	for i:=1 to Display.Height do begin

   	 for j:=1 to Display.Width do begin

 	 X:=ScreenToPlane(j,True);

      Y:=ScreenToPlane(i,False);

       	 C:=CheckMandelbrot(X,Y);

       	 Display.Canvas.Pixels[j,i]:=MandelbrotPalette[C];

        end;

        Display.Invalidate;

        Application.ProcessMessages;

        if (Application.Terminated) then Break;

    end;

    DoZoomIn:=True;

    LastX:=-200;

    LastY:=-200;

end;





procedure TForm1.DisplayMouseMove(Sender: TObject; Shift: TShiftState;

  X, Y: Integer);

begin

	if DoZoomIn then with Display.Canvas do begin

  Pen.Style:=psSolid;

        Pen.Mode:=pmNot;

        Brush.Style:=bsClear;

        Rectangle(LastX-ZOOM_RECT,LastY-ZOOM_RECT,LastX+ZOOM_RECT,LastY+ZOOM_RECT);

        LastX:=X;LastY:=Y;

  Rectangle(LastX-ZOOM_RECT,LastY-ZOOM_RECT,LastX+ZOOM_RECT,LastY+ZOOM_RECT);

  Pen.Mode:=pmCopy;

    end;

end;



procedure TForm1.DisplayMouseUp(Sender: TObject; Button: TMouseButton;

  Shift: TShiftState; X, Y: Integer);

begin

	if Tag=0 then begin

   	 DrawMandelbrot;

        Tag:=1;

    end else

    if Button=mbRight then begin

   	 MakeMandelbrotPalette;

  DoZoomin:=False;

        DrawMandelbrot;

    end else

	if DoZoomIn then begin

        Display.Canvas.Rectangle(LastX-ZOOM_RECT,LastY-ZOOM_RECT,LastX+ZOOM_RECT,LastY+ZOOM_RECT);

        MinX:=ScreenToPlane(LastX-ZOOM_RECT,True);

        MinY:=ScreenToPlane(LastY+ZOOM_RECT,False);

        MaxX:=ScreenToPlane(LastX+ZOOM_RECT,True);

        MaxY:=ScreenToPlane(LastY-ZOOM_RECT,False);

        Rescale;

        DoZoomIn:=False;

        ResetDisplay;

        DrawMandelbrot;

	end;

end;



end.

وشكرا

مــــMADIــــدي