ارسال صورة سطح المكتب لملف وورد من دلفي

[gigi]

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

[kachwahed]

وعليكم السلام
المثال الأول:
مكون TImage و TButton ثم:

PHP كود :

function GetScreenShot: TBitmap;
var
  Desktop: HDC;
begin
  Result  := TBitmap.Create;
  Desktop := GetDC(0);
  try
    try
      Result.PixelFormat := pf32bit;
      Result.Width := Screen.Width;
      Result.Height := Screen.Height;
      BitBlt(Result.Canvas.Handle, 0, 0, Result.Width, Result.Height, Desktop, 0, 0, SRCCOPY);
      Result.Modified := True;
    finally
      ReleaseDC(0, Desktop);
    end;
  except
    Result.Free;
    Result := nil;
  end;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
  Image1.Picture.Bitmap := GetScreenShot;
end; 


المثال الثاني: نفسه الأول فقط بـ TButton ثم:

PHP كود :

procedure TForm1.Button1Click(Sender: TObject);
var DCDesk: HDC; // hDC of Desktop
  bmp: TBitmap;
begin
  {Create a bitmap}
  bmp := TBitmap.Create;

  {Set a bitmap sizes}
  bmp.Height := Screen.Height;
  bmp.Width := Screen.Width;

  {Get a desktop DC handle - handle of a display device context}
  DCDesk := GetWindowDC(GetDesktopWindow);

  {Copy to any canvas, here canvas of an image}
  BitBlt(bmp.Canvas.Handle, 0, 0, Screen.Width, Screen.Height,
         DCDesk, 0, 0, SRCCOPY);

  {Save the bitmap}
  bmp.SaveToFile('c:\ScreenShot.bmp');

  {Release desktop DC handle}
  ReleaseDC(GetDesktopWindow, DCDesk);

  {Release a bitmap}
  bmp.Free;
end; 


الصورة مخزنة في c:\ScreenShot.bmp
مثال ثالث (أفضل لإصدارات Windows الحديثة):

PHP كود :

procedure CaptureScreen(AFileName: string);
const
  CAPTUREBLT = $40000000;
var
  hdcScreen: HDC;
  hdcCompatible: HDC;
  bmp: TBitmap;
  hbmScreen: HBITMAP;
begin
  // Create a normal DC and a memory DC for the entire screen. The
  // normal DC provides a "snapshot" of the screen contents. The
  // memory DC keeps a copy of this "snapshot" in the associated
  // bitmap.

  hdcScreen := CreateDC('DISPLAY', nil, nil, nil);
  hdcCompatible := CreateCompatibleDC(hdcScreen);
  // Create a compatible bitmap for hdcScreen.

  hbmScreen := CreateCompatibleBitmap(hdcScreen,
    GetDeviceCaps(hdcScreen, HORZRES),
    GetDeviceCaps(hdcScreen, VERTRES));

  // Select the bitmaps into the compatible DC.
  SelectObject(hdcCompatible, hbmScreen);
  bmp := TBitmap.Create;
  bmp.Handle := hbmScreen;
  BitBlt(hdcCompatible,
    0, 0,
    bmp.Width, bmp.Height,
    hdcScreen,
    0, 0,
    SRCCOPY or CAPTUREBLT);

  bmp.SaveToFile(AFileName);
  bmp.Free;
  DeleteDC(hdcScreen);
  DeleteDC(hdcCompatible);
end; 


للاستخدام TButton ثم:

كود :

procedure TForm1.Button1Click(Sender: TObject); begin CaptureScreen('c:\ScreenShot.bmp'); end;

بالتوفيق.

[Rover]

http://www.delphi4arab.net/forum/showthr...p?tid=2356

Unlimited Delphi code bank

ستجد فيه الكثير من الاكواد التي ستفيدك في هذا الموضوع ..

[kachwahed]

مثال للتعامل مع MS Word من خلال OLE
خمس مكونات TEdit، مكون TRadioGroup وTComboBox وTButton للتشغيل:

PHP كود :

uses
  ComObj;

procedure TForm1.Button1Click(Sender: TObject);
var
  Word: OLEVariant;
begin
  try
    Word := CreateOleObject('Word.Application');
  except
    ShowMessage('Cannot start Word !');
    Exit;
  end;
  // Show Word
  Word.Visible := True;
  // Add a new Document
  Word.Documents.Add;
  if Word.ActiveWindow.View.SplitSpecial <> 0 then
    Word.ActiveWindow.Panes[2].Close;
  if (Word.ActiveWindow.ActivePane.View.type = 1) or
    (Word.ActiveWindow.ActivePane.View.type = 2) or
    (Word.ActiveWindow.ActivePane.View.type = 5) then
    Word.ActiveWindow.ActivePane.View.type := 3;
  Word.ActiveWindow.ActivePane.View.SeekView := 9;

  Word.Selection.Font.Name     := 'Times New Roman';
  Word.Selection.Font.Size     := 12;
  Word.Selection.Font.Bold     := True;
  Word.Selection.ParagraphFormat.Alignment := 1;
  Word.Selection.TypeText(Text :=
    'Tutorial Delphi4Arab - Automation MS Word');

  if Word.Selection.HeaderFooter.IsHeader = True then
    Word.ActiveWindow.ActivePane.View.SeekView := 10
  else
    Word.ActiveWindow.ActivePane.View.SeekView := 9;
  Word.Selection.TypeText(Text :=
    'Automation MS Word - Kachwahed for Delphi4arab.com');
  Word.ActiveWindow.ActivePane.View.SeekView := 0;
  Word.Selection.TypeText(Text := Edit2.Text + ' ' + edit1.Text);
  Word.Selection.TypeParagraph;
  Word.Selection.TypeText(Text := edit3.Text);
  Word.Selection.TypeParagraph;
  Word.Selection.TypeParagraph;
  Word.Selection.Font.Name := 'Times New Roman';
  Word.Selection.Font.Size := 12;
  Word.Selection.Font.Bold := True;

  Word.Selection.TypeText(Text := edit4.Text + ' ' + edit5.Text);
  Word.Selection.TypeParagraph;
  Word.Selection.TypeParagraph;
  Word.Selection.TypeParagraph;
  Word.Selection.TypeParagraph;
  Word.Selection.Font.Name     := 'Arial';
  Word.Selection.Font.Size     := 14;
  Word.Selection.Font.Bold     := True;
  Word.Selection.TypeText(Text := Combobox1.Text);
  Word.Selection.TypeParagraph;
  Word.Selection.TypeParagraph;
  Word.Selection.TypeParagraph;
  Word.Selection.Font.Name := 'Times New Roman';
  Word.Selection.Font.Size := 12;
  Word.Selection.Font.Bold := True;
  case RadioGroup1.ItemIndex of
  0: Word.Selection.TypeText(Text := 'First Item Selected... ' + edit1.Text);
  1: Word.Selection.TypeText(Text := 'Second Item Selected...' + edit1.Text);
  2: Word.Selection.TypeText(Text := 'Third item text... ' + edit1.Text);
  end;
end; 


الأمثلة لـ Simon Grossenbacher بتصرف
الباقي عليك.

[gigi]

السلام عليكم

افهم من الكود التالي

كود :

Word.Selection.Font.Name := 'Times New Roman'; Word.Selection.Font.Size := 12; Word.Selection.Font.Bold := True; Word.Selection.ParagraphFormat.Alignment := 1; Word.Selection.TypeText(Text := 'Tutorial Delphi4Arab - Automation MS Word');

انه من خلال هذا الامر Word.Selection يمكن الولوج الى ملف تطبيق الوورد واضافة كلمة , خط , لون ....... الخ

وبالتالي لفتح ملف وورد ووضع صورة فيه يجب ان يكون الكود هكذا

كود :

Word.Selection.image:=GetScreenShot;

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