Текущий архив: 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.47 MB
Время: 0.012 c
