Текущий архив: 2013.12.15;
Скачать: CL | DM;

Вниз

Доступ к объектам метафайла   Найти похожие ветки 

← →
Jimmy   (2013-02-28 08:49) [0]

Нашел код, как получить доступ к объектам метафайла; код приведен ниже. Но не во всем смог разобраться. Первый вопрос: какой код нужно добавить, чтобы, например, прочитав объекты MyMetaFile, изменить заливку второго эллипса и нарисовать прямоугольник перед выводом этих объектов на экран? Заранее спасибо!

function MyEnhMetaFileProc(DC: HDC; {handle to device context}
lpHTable: PHANDLETABLE; {pointer to metafile handle table}
lpEMFR: PENHMETARECORD; {pointer to metafile record}
nObj: integer; {count of objects}
TheForm: TForm1): integer; stdcall;
begin
{draw the metafile record}
PlayEnhMetaFileRecord(dc, lpHTable^, lpEMFR^, nObj);
{set to zero to stop metafile enumeration}
result := 1;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
MyMetafile: TMetafile;
lpENHMETAHEADER: PENHMETAHEADER; {extra metafile info}
lpENHMETAHEADERSIZE: DWORD;
NumMetaRecords: DWORD;
begin
{Create a metafile}
MyMetafile := TMetafile.Create;
with TMetafileCanvas.Create(MyMetafile, 0) do
try
  Brush.Color := clRed;
  Ellipse(0, 0, 100, 100);
  Ellipse(100, 100, 200, 200);
  Ellipse(200, 200, 300, 300);
  Ellipse(300, 300, 400, 400);
  Ellipse(400, 400, 500, 500);
  Ellipse(500, 500, 600, 600);
finally
  Free;
end;
{we might as well get some extra metafile info}
lpENHMETAHEADERSIZE := GetEnhMetaFileHeader(MyMetafile.Handle, 0, nil);
NumMetaRecords := 0;
if (lpENHMETAHEADERSIZE > 0) then
begin
  GetMem(lpENHMETAHEADER, lpENHMETAHEADERSIZE);
  GetEnhMetaFileHeader(MyMetafile.Handle, lpENHMETAHEADERSIZE, lpENHMETAHEADER);
  {Here is an example of getting number of metafile records}
  NumMetaRecords := lpENHMETAHEADER^.nRecords;
  {enumerate the records}
  EnumEnhMetaFile(Canvas.Handle, MyMetafile.Handle, @MyEnhMetaFileProc, self,
    Rect(0, 0, 600, 600));
  FreeMem(lpENHMETAHEADER, lpENHMETAHEADERSIZE);
end;
MyMetafile.Free;
end;

---

← →
clickmaker ©   (2013-02-28 11:27) [1]

> изменить заливку второго эллипса и нарисовать прямоугольник
> перед выводом этих объектов на экран?

SelectObject(dc, NewBrushHandle) перед проигрыванием эллипса ?

Rectangle(dc, x1, y1, x2, y2);

---

← →
Jimmy   (2013-02-28 13:23) [2]

Да, вроде получилось, только после строк

NewBrushHandle:=TBrush.Create;
NewBrushHandle.Color:=clBlue;
SelectObject(dc, NewBrushHandle.Handle);
PlayEnhMetaFileRecord(dc, lpHTable^, lpEMFR^, nObj);
result := 1;
NewBrushHandle.Free;
все эллипсы стали синие...

---

← →
MBo ©   (2013-02-28 13:27) [3]

запомни текущую кисть и восстанови её после своих добавок

---

← →
clickmaker ©   (2013-03-01 12:32) [4]

hBrush := CreateSolidBrush($0000FF);
hOldBrush := SelectObject(dc, hBrush);
PlayEnhMetaFileRecord(dc, lpHTable^, lpEMFR^, nObj);
SelectObject(dc, hOldBrush);

---

Страницы: 1 вся ветка

Текущий архив: 2013.12.15;
Скачать: CL | DM;

Наверх

Память: 0.47 MB
Время: 0.007 c