Форум: "Начинающим";
Текущий архив: 2013.12.15;
Скачать: [xml.tar.bz2];
ВнизДоступ к объектам метафайла Найти похожие ветки
← →
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;
Скачать: [xml.tar.bz2];
Память: 0.45 MB
Время: 0.002 c