아래 소스 GetTextExtentExPointW 에서 "Printer is not currently printing." 오류가 발생합니다.
해결 방법이 없을까요....
procedure TForm1.SetQRMemo(s: string);
var
s1: string;
ts: tstringlist;
points: array [0..1023] of Integer;
sz: tsize;
i, cnt, w: Integer;
tempfont: TFont;
begin
qrmemo1.Lines.Clear;
if trim(s) = '' then exit;
ts := tstringlist.create;
ts.text := s;
tempfont := tfont.create;
tempfont := printer.canvas.Font;
printer.canvas.Font := qrmemo1.Font;
w := printer.canvas.textwidth(' ');
for i := 0 to ts.count do
begin
s := ts.strings[i];
cnt := 0;
while cnt <= length(s) do
begin
if s = '' then
begin
qrmemo1.lines.add('');
break;
end;
// 여기서 오류가 발생합니다...
getTextExtentExPoint(printer.canvas.handle, pchar(s), qrmemo1.width, length(s), @cnt, @points[0], sz);
while (cnt>0) and (cnt < length(s)) and (s[cnt+1] <> ' ') and (pos(s[cnt],';:?)!}]')=0) do
dec(cnt);
if (cnt = 0) or (cnt = length(s)) then
begin
qrmemo1.lines.add(s);
break;
end;
s1 := copy(s, 1, cnt);
insertblanks(s1, (qrmemo1.width - points[cnt-1]) div w);
qrmemo1.Lines.Add(s1);
s := trim(copy(s, cnt+1, length(s)));
end;
end;
ts.free;
printer.canvas.font := tempfont;
tempfont.free;
end;
procedure TForm1. insertblanks(var s: string; cnt: integer);
var
i: Integer;
begin
i := 1;
while cnt > 0 do
begin
if i > length(s) then i := 1;
while (i<length(s)) and (s[i] = ' ') do inc(i);
while (i<length(s)) and (s[i] <> ' ') do inc(i);
if i < length(s) then
insert(' ',s, i+1)
else
s := ' '+s;
inc(i);
dec(cnt);
end;
end;