Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2005.11.27;
Скачать: CL | DM;

Вниз

EMF - изменение записей - как заполнить intercharacter spacing ?   Найти похожие ветки 

 
GuAV ©   (2005-09-25 01:10) [0]

Здравствуйте.

Пытаюсь изменять emf в EnumMetaFileProc, перезаполняя записи с текстом.
Эти содержат одну или более структуру EMRTEXT (в моём случае EMR_EXTTEXTOUTW содержат одну), после следуют массив символов текста и массив из intercharacter spacing.
Заполняю его приведенной прцедурой. Однако интервалы не выглядят нормально.


procedure SetInterChSpaceW(DC: HDC; Count: Integer; Str: PWCharArray; Arr: PSpacingArray);
var
 OneABC: TABC;
 I: Integer;
begin
 ZeroMemory(Arr, SizeOf(Integer) * Count); // оставлять нули не работает, надо заплонять.
 for I := 0 to Count - 1 do
 begin
   GetCharABCWidthsW(DC, ord(Str[I]), ord(Str[I]), OneABC);
   Arr[I] := OneABC.abcA + Integer(OneABC.abcB) + OneABC.abcC;
 end;
end;


Что я делаю не так ?
Является ли данная идея подстановки строк в EMF неверной в принципе ?


 
GuAV ©   (2005-09-25 01:14) [1]

Забыл указать, DC - это целевой DC - пока paintbox.canvas.handle, count - кол-во символв, str - уже заполненная строка в записи, arr - заполняемый массив в записи.
dword-aling после строки соблюдён.


 
Джо ©   (2005-09-25 04:36) [2]

Может, я не вполне верно понял постановку задачи, но, вообще-то, записи, передаваемые в EnumProc - только для чтения. И если ты что-то в них все-таки поменял, это не значит, что ты изменил что-то в самом метафайле.


 
GuAV ©   (2005-09-25 11:42) [3]

Джо ©   (25.09.05 4:36) [2]

Да, я в курсе. Согласно справке, исходные записи метафайл изменять нельзя вообще. Я вызываю PlayEnhMetaFileRecord из EnumMetaFileProc со старой записью, если менять не нужно, для изменяемой - создаю копию с изменёнными интересующими параметрами и вызываю PlayEnhMetaFileRecord уже с ней.

Приведу наверное весь код - он пока не такй уж большой.

unit Unit1;

interface

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

type
 TForm1 = class(TForm)
   Edit1: TEdit;
   Button1: TButton;
   PaintBox1: TPaintBox;
   Memo1: TMemo;
   procedure Button1Click(Sender: TObject);
 private
   { Private declarations }
   FReplList: TStrings;
   procedure OnWideString(var S: WideString);
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

type
 TOnWideString = procedure(var S: WideString) of object;

 TEnumExtraData = class
   FOnWideString: TOnWideString;
 end;

type
 PWCharArray = ^TWCharArray;
 TWCharArray = array[0..0] of Char;
 PSpacingArray = ^TSpacingArray;
 TSpacingArray = array[0..0] of Integer;

procedure SetInterChSpaceW(DC: HDC; Count: Integer; Str: PWCharArray; Arr: PSpacingArray);
var
 OneABC: TABC;
 I: Integer;
begin
 ZeroMemory(Arr, SizeOf(Integer) * Count);
 for I := 0 to Count - 1 do
 begin
   GetCharABCWidthsW(DC, ord(Str[I]), ord(Str[I]), OneABC);
   Arr[I] := OneABC.abcA + Integer(OneABC.abcB) + OneABC.abcC;
 end;
end;

function DAlign(I: DWORD): DWORD;
begin
 Result := (I + 3) and (not 3);
end;

function AllocatePEMRExtTextOutW(Length: Integer): PEMRExtTextOut;
const StructSize = SizeOf(TEMRExtTextOut);
var Size, StrSize: Integer;
begin
 StrSize := DAlign(Length * SizeOf(WideChar));
 Size := StructSize + StrSize + Length * SizeOf(Integer);
 GetMem(Result, Size);
 Result.emr.iType := EMR_EXTTEXTOUTW;
 Result.emr.nSize := Size;
 Result.emrtext.offString := StructSize;
 Result.emrtext.nChars := Length;
 Result.emrtext.offDx := StructSize + StrSize
end;

procedure AssignPEMRExtTextOutOptions(Src, Dest: PEMRExtTextOut);
begin
 Dest.rclBounds := Src.rclBounds;
 Dest.iGraphicsMode := Src.iGraphicsMode;
 Dest.exScale := Src.exScale;
 Dest.eyScale := Src.eyScale;
 Dest.emrtext.ptlReference := Src.emrtext.ptlReference;
 Dest.emrtext.fOptions := Src.emrtext.fOptions;
 Dest.emrtext.rcl := Src.emrtext.rcl;
end;

procedure GetNewPEMRExtTextOutW(DC: HDC; Src: PEMRExtTextOut; var Dest: PEMRExtTextOut;
 Data: TEnumExtraData);
var
 PStr, PArr: Pointer;
 S: WideString;
begin
 PStr := Ptr(Src.emrtext.offString + DWORD(Src));
 SetLength(S, Src.emrtext.nChars);
 Move(PStr^, S[1], Length(S) * SizeOf(WideChar));
 Data.FOnWideString(S);
 Dest := AllocatePEMRExtTextOutW(Length(S));
 AssignPEMRExtTextOutOptions(Src, Dest);
 PStr := Ptr(Dest.emrtext.offString + DWORD(Dest));
 PArr := Ptr(Dest.emrtext.offDx + DWORD(Dest));
 Move(S[1], PStr^, Dest.emrtext.nChars * SizeOf(WideChar));
 SetInterChSpaceW(DC, Dest.emrtext.nChars, PStr, PArr);
end;

function EnumMetaFileProc(hDC: HDC; lpHTable: PHandleTable; lpMFR: PEnhMetaRecord;
 nObj: Integer; lpClientData: LPARAM): Integer; stdcall;
var NewMFR: PEnhMetaRecord;
begin
 case lpMFR.iType of
   EMR_EXTTEXTOUTW:
     begin
       GetNewPEMRExtTextOutW(hDC, PEMRExtTextOut(lpMFR),
         PEMRExtTextOut(NewMFR), TEnumExtraData(lpClientData));
     end;
 else
   NewMFR := nil;
 end;

 if NewMFR <> nil then
 begin
   PlayEnhMetaFileRecord(hDC, lpHTable^, NewMFR^, nObj);
   FreeMem(NewMFR);
 end
 else
 begin
   PlayEnhMetaFileRecord(hDC, lpHTable^, lpMFR^, nObj);
 end;
 Result := 1;
end;

procedure TForm1.Button1Click(Sender: TObject);
var MF: TMetaFile; R: TRect; ED: TEnumExtraData;
begin
 FReplList := TStringList.Create;
 FReplList.AddStrings(Memo1.Lines);
 try
   MF := TMetafile.Create;
   try
     MF.LoadFromFile(Edit1.Text);
     R := Rect(0, 0, MF.Width, MF.Height);
     ED := TEnumExtraData.Create;
     try
       ED.FOnWideString := OnWideString;
       EnumEnhMetaFile(PaintBox1.Canvas.Handle, MF.Handle, @EnumMetaFileProc, ED, R);
     finally
       ED.Free;
     end;
   finally
     MF.Free;
   end;
 finally
   FReplList.Free;
 end;
end;

procedure TForm1.OnWideString(var S: WideString);
begin
 S := FReplList.Values[S];
end;

end.


 
GuAV ©   (2005-09-25 12:24) [4]

@%%@$##$ !


>  TWCharArray = array[0..0] of Char;

TWCharArray = array[0..0] of WideChar; !

Вот тут была ошибка. Не привык с уникодом работать...
Спасибо Джо и всем кто просмотрел и извините за отнятое время..


 
Джо ©   (2005-09-25 16:24) [5]


>  [4] GuAV ©   (25.09.05 12:24)

:)



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

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

Наверх




Память: 0.49 MB
Время: 0.043 c
8-1120357045
Канвас
2005-07-03 06:17
2005.11.27
Как сделать Canvas.CopyRect для наклонной области ?


14-1131376171
Lucius
2005-11-07 18:09
2005.11.27
Где можно найти этот компонент?


1-1131007433
ВоваВова
2005-11-03 11:43
2005.11.27
меню для tray иконки


14-1130933341
konda
2005-11-02 15:09
2005.11.27
IP телефония


14-1130908536
Slider007
2005-11-02 08:15
2005.11.27
Про вчерашний гололед в Новосибирске