Q&A

  • [질문] GetTextExtentExPointW 에서 오류

아래 소스  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;

 

0  COMMENTS