Awkward's private repo sync

git-svn-id: http://svn.miranda-ng.org/main/trunk@11279 1316c22d-e87f-b044-9b9b-93d7a3e3ba9c

1 files changed, 586 insertions, 0 deletions

diff --git a/plugins/Utils.pas/rtfutils.pas b/plugins/Utils.pas/rtfutils.pas
new file mode 100644
index 0000000000..905c98ef0e
--- /dev/null
+++ b/plugins/Utils.pas/rtfutils.pas
@@ -0,0 +1,586 @@
+unit rtfutils;

+

+interface

+

+uses

+  richedit,

+  windows;

+

+

+function IsRTF(const Value: pWideChar): Boolean;

+

+//used for Export only

+function GetRichRTFW(RichEditHandle: THANDLE; var RTFStream: PWideChar;

+                    SelectionOnly, PlainText, NoObjects, PlainRTF: Boolean): Integer;

+function GetRichRTFA(RichEditHandle: THANDLE; var RTFStream: PAnsiChar;

+                    SelectionOnly, PlainText, NoObjects, PlainRTF: Boolean): Integer;

+

+function GetRichString(RichEditHandle: THANDLE; SelectionOnly: Boolean = false): PWideChar;

+

+function SetRichRTFW(RichEditHandle: THANDLE; const RTFStream: PWideChar;

+                    SelectionOnly, PlainText, PlainRTF: Boolean): Integer;

+function SetRichRTFA(RichEditHandle: THANDLE; const RTFStream: PAnsiChar;

+                    SelectionOnly, PlainText, PlainRTF: Boolean): Integer;

+

+function FormatString2RTFW(Source: PWideChar; Suffix: PAnsiChar = nil): PAnsiChar;

+function FormatString2RTFA(Source: PAnsiChar; Suffix: PAnsiChar = nil): PAnsiChar;

+

+procedure ReplaceCharFormatRange(RichEditHandle: THANDLE;

+     const fromCF, toCF: CHARFORMAT2; idx, len: Integer);

+procedure ReplaceCharFormat(RichEditHandle: THANDLE; const fromCF, toCF: CHARFORMAT2);

+

+function GetTextLength(RichEditHandle:THANDLE): Integer;

+function GetTextRange (RichEditHandle:THANDLE; cpMin,cpMax: Integer): PWideChar;

+

+function BitmapToRTF(pict: HBITMAP): pAnsiChar;

+

+implementation

+

+uses

+  common;

+

+function IsRTF(const Value: pWideChar): Boolean;

+const

+  RTF_BEGIN_1  = '{\RTF';

+  RTF_BEGIN_2  = '{URTF';

+begin

+  Result := (StrPosW(Value,RTF_BEGIN_1) = Value)

+         or (StrPosW(Value,RTF_BEGIN_2) = Value);

+end;

+

+type

+  PTextStream = ^TTextStream;

+  TTextStream = record

+    Size: Integer;

+    case Boolean of

+      false: (Data:  PAnsiChar);

+      true:  (DataW: PWideChar);

+  end;

+

+function RichEditStreamLoad(dwCookie: DWORD_PTR; pbBuff: PByte; cb: Longint; var pcb: Longint): dword; stdcall;

+var

+  pBuff: PAnsiChar;

+begin

+  with PTextStream(dwCookie)^ do

+  begin

+    pBuff := Data;

+    pcb := Size;

+    if pcb > cb then

+      pcb := cb;

+    Move(pBuff^, pbBuff^, pcb);

+    Inc(Data, pcb);

+    Dec(Size, pcb);

+  end;

+  Result := 0;

+end;

+

+function RichEditStreamSave(dwCookie: DWORD_PTR; pbBuff: PByte; cb: Longint; var pcb: Longint): dword; stdcall;

+var

+  prevSize: Integer;

+begin

+  with PTextStream(dwCookie)^ do

+  begin

+    prevSize := Size;

+    Inc(Size,cb);

+    ReallocMem(Data,Size);

+    Move(pbBuff^,(Data+prevSize)^,cb);

+    pcb := cb;

+  end;

+  Result := 0;

+end;

+

+function _GetRichRTF(RichEditHandle: THANDLE; TextStream: PTextStream;

+                    SelectionOnly, PlainText, NoObjects, PlainRTF, Unicode: Boolean): Integer;

+var

+  es: TEditStream;

+  Format: Longint;

+begin

+  format := 0;

+  if SelectionOnly then

+    Format := Format or SFF_SELECTION;

+  if PlainText then

+  begin

+    if NoObjects then

+      Format := Format or SF_TEXT

+    else

+      Format := Format or SF_TEXTIZED;

+    if Unicode then

+      Format := Format or SF_UNICODE;

+  end

+  else

+  begin

+    if NoObjects then

+      Format := Format or SF_RTFNOOBJS

+    else

+      Format := Format or SF_RTF;

+    if PlainRTF then

+      Format := Format or SFF_PLAINRTF;

+    // if Unicode then   format := format or SF_USECODEPAGE or (CP_UTF16 shl 16);

+  end;

+  TextStream^.Size := 0;

+  TextStream^.Data := nil;

+  es.dwCookie := DWORD_PTR(TextStream);

+  es.dwError := 0;

+  es.pfnCallback := @RichEditStreamSave;

+  SendMessage(RichEditHandle, EM_STREAMOUT, format, LPARAM(@es));

+  Result := es.dwError;

+end;

+

+function GetRichRTFW(RichEditHandle: THANDLE; var RTFStream: PWideChar;

+                    SelectionOnly, PlainText, NoObjects, PlainRTF: Boolean): Integer;

+var

+  Stream: TTextStream;

+begin

+  Result := _GetRichRTF(RichEditHandle, @Stream,

+                        SelectionOnly, PlainText, NoObjects, PlainRTF, PlainText);

+  if Assigned(Stream.DataW) then

+  begin

+    if PlainText then

+      StrDupW(RTFStream, Stream.DataW, Stream.Size div SizeOf(WideChar))

+    else

+      AnsiToWide(Stream.Data, RTFStream, CP_ACP);

+    FreeMem(Stream.Data, Stream.Size);

+  end

+  else

+    RTFStream := nil;

+end;

+

+function GetRichRTFA(RichEditHandle: THANDLE; var RTFStream: PAnsiChar;

+                    SelectionOnly, PlainText, NoObjects, PlainRTF: Boolean): Integer;

+var

+  Stream: TTextStream;

+begin

+  Result := _GetRichRTF(RichEditHandle, @Stream,

+                        SelectionOnly, PlainText, NoObjects, PlainRTF, False);

+  if Assigned(Stream.Data) then

+  begin

+    StrDup(RTFStream, Stream.Data, Stream.Size - 1);

+    FreeMem(Stream.Data, Stream.Size);

+  end

+  else

+    RTFStream := nil;

+end;

+

+function GetRichString(RichEditHandle: THANDLE; SelectionOnly: Boolean = false): PWideChar;

+begin

+  GetRichRTFW(RichEditHandle,Result,SelectionOnly,True,True,False);

+end;

+

+

+function _SetRichRTF(RichEditHandle: THANDLE; TextStream: PTextStream;

+                    SelectionOnly, PlainText, PlainRTF, Unicode: Boolean): Integer;

+var

+  es: TEditStream;

+  Format: Longint;

+begin

+  Format := 0;

+  if SelectionOnly then

+    Format := Format or SFF_SELECTION;

+  if PlainText then

+  begin

+    Format := Format or SF_TEXT;

+    if Unicode then

+      Format := Format or SF_UNICODE;

+  end

+  else

+  begin

+    Format := Format or SF_RTF;

+    if PlainRTF then

+      Format := Format or SFF_PLAINRTF;

+    // if Unicode then  format := format or SF_USECODEPAGE or (CP_UTF16 shl 16);

+  end;

+  es.dwCookie := LPARAM(TextStream);

+  es.dwError := 0;

+  es.pfnCallback := @RichEditStreamLoad;

+  SendMessage(RichEditHandle, EM_STREAMIN, format, LPARAM(@es));

+  Result := es.dwError;

+end;

+

+function SetRichRTFW(RichEditHandle: THANDLE; const RTFStream: PWideChar;

+                    SelectionOnly, PlainText, PlainRTF: Boolean): Integer;

+var

+  Stream: TTextStream;

+  Buffer: PAnsiChar;

+begin

+  if PlainText then

+  begin

+    Stream.DataW := RTFStream;

+    Stream.Size  := StrLenW(RTFStream) * SizeOf(WideChar);

+    Buffer := nil;

+  end

+  else

+  begin

+    WideToAnsi(RTFStream, Buffer, CP_ACP);

+    Stream.Data := Buffer;

+    Stream.Size := StrLen(Buffer);

+  end;

+  Result := _SetRichRTF(RichEditHandle, @Stream,

+                        SelectionOnly, PlainText, PlainRTF, PlainText);

+  mFreeMem(Buffer);

+end;

+

+function SetRichRTFA(RichEditHandle: THANDLE; const RTFStream: PAnsiChar;

+                    SelectionOnly, PlainText, PlainRTF: Boolean): Integer;

+var

+  Stream: TTextStream;

+begin

+  Stream.Data := RTFStream;

+  Stream.Size := StrLen(RTFStream);

+  Result := _SetRichRTF(RichEditHandle, @Stream,

+                        SelectionOnly, PlainText, PlainRTF, False);

+end;

+

+function FormatString2RTFW(Source: PWideChar; Suffix: PAnsiChar = nil): PAnsiChar;

+var

+  Text: PWideChar;

+  res: PAnsiChar;

+  buf: array [0..15] of AnsiChar;

+  len: integer;

+begin

+  // calculate len

+  len:=Length('{\uc1 ');

+  Text := PWideChar(Source);

+  while Text[0] <> #0 do

+  begin

+    if (Text[0] = #13) and (Text[1] = #10) then

+    begin

+      inc(len,Length('\par '));

+      Inc(Text);

+    end

+    else

+      case Text[0] of

+        #10: inc(len,Length('\par '));

+        #09: inc(len,Length('\tab '));

+        '\', '{', '}':

+          inc(len,2);

+      else

+        if Word(Text[0]) < 128 then

+          inc(len)

+        else

+          inc(len,3+IntStrLen(Word(Text[0]),10));

+      end;

+    Inc(Text);

+  end;

+  inc(len,StrLen(Suffix)+2);

+

+  // replace

+  Text := PWideChar(Source);

+  GetMem(Result,len);

+  res:=StrCopyE(Result,'{\uc1 ');

+  while Text[0] <> #0 do

+  begin

+    if (Text[0] = #13) and (Text[1] = #10) then

+    begin

+      res:=StrCopyE(res,'\par ');

+      Inc(Text);

+    end

+    else

+      case Text[0] of

+        #10: res:=StrCopyE(res,'\par ');

+        #09: res:=StrCopyE(res,'\tab ');

+        '\', '{', '}': begin

+          res^:='\'; inc(res);

+          res^:=AnsiChar(Text[0]); inc(res);

+        end;

+      else

+        if Word(Text[0]) < 128 then

+        begin

+          res^:=AnsiChar(Word(Text[0])); inc(res);

+        end

+        else

+        begin

+          res:=StrCopyE(

+            StrCopyE(res,'\u'),

+            IntToStr(buf,Word(Text[0])));

+          res^:='?'; inc(res);

+        end;

+      end;

+    Inc(Text);

+  end;

+

+  res:=StrCopyE(res, Suffix);

+  res^:='}'; inc(res); res^:=#0;

+end;

+

+function FormatString2RTFA(Source: PAnsiChar; Suffix: PAnsiChar = nil): PAnsiChar;

+var

+  Text,res: PAnsiChar;

+  len: integer;

+begin

+  // calculate len

+  len:=1;

+  Text := PAnsiChar(Source);

+  while Text[0] <> #0 do

+  begin

+    if (Text[0] = #13) and (Text[1] = #10) then

+    begin

+      inc(len,Length('\line '));

+      Inc(Text);

+    end

+    else

+      case Text[0] of

+        #10: inc(len,Length('\line '));

+        #09: inc(len,Length('\tab '));

+        '\', '{', '}':

+          inc(len,2);

+      else

+        inc(len);

+      end;

+    Inc(Text);

+  end;

+  inc(len,StrLen(Suffix)+2);

+

+  // replace

+  Text := PAnsiChar(Source);

+  GetMem(Result,len);

+  res:=Result;

+  res^ := '{'; inc(res);

+  while Text[0] <> #0 do

+  begin

+    if (Text[0] = #13) and (Text[1] = #10) then

+    begin

+      res:=StrCopyE(res,'\line ');

+      Inc(Text);

+    end

+    else

+      case Text[0] of

+        #10: res:=StrCopyE(res,'\line ');

+        #09: res:=StrCopyE(res,'\tab ');

+        '\', '{', '}': begin

+          res^:='\'; inc(res);

+          res^:=Text[0]; inc(res);

+        end;

+      else

+        res^:=Text[0]; inc(res);

+      end;

+    Inc(Text);

+  end;

+

+  res:=StrCopyE(res, Suffix);

+  res^:='}'; inc(res); res^:=#0;

+end;

+

+function GetTextLength(RichEditHandle: THANDLE): Integer;

+var

+  gtxl: GETTEXTLENGTHEX;

+begin

+  gtxl.flags    := GTL_DEFAULT or GTL_PRECISE;

+  gtxl.codepage := 1200; // Unicode

+  gtxl.flags    := gtxl.flags or GTL_NUMCHARS;

+  Result := SendMessage(RichEditHandle, EM_GETTEXTLENGTHEX, WPARAM(@gtxl), 0);

+end;

+

+procedure ReplaceCharFormatRange(RichEditHandle: THANDLE;

+     const fromCF, toCF: CHARFORMAT2; idx, len: Integer);

+var

+  cr: CHARRANGE;

+  cf: CHARFORMAT2;

+  loglen: Integer;

+  res: DWord;

+begin

+  if len = 0 then

+    exit;

+  cr.cpMin := idx;

+  cr.cpMax := idx + len;

+  SendMessage(RichEditHandle, EM_EXSETSEL, 0, LPARAM(@cr));

+  ZeroMemory(@cf, SizeOf(cf));

+  cf.cbSize := SizeOf(cf);

+  cf.dwMask := fromCF.dwMask;

+  res := SendMessage(RichEditHandle, EM_GETCHARFORMAT, SCF_SELECTION, LPARAM(@cf));

+  if (res and fromCF.dwMask) = 0 then

+  begin

+    if len = 2 then

+    begin

+      // wtf, msdn tells that cf will get the format of the first AnsiChar,

+      // and then we have to select it, if format match or second, if not

+      // instead we got format of the last AnsiChar... weired

+      if (cf.dwEffects and fromCF.dwEffects) = fromCF.dwEffects then

+        Inc(cr.cpMin)

+      else

+        Dec(cr.cpMax);

+      SendMessage(RichEditHandle, EM_EXSETSEL, 0, LPARAM(@cr));

+      SendMessage(RichEditHandle, EM_SETCHARFORMAT, SCF_SELECTION, LPARAM(@toCF));

+    end

+    else

+    begin

+      loglen := len div 2;

+      ReplaceCharFormatRange(RichEditHandle, fromCF, toCF, idx, loglen);

+      ReplaceCharFormatRange(RichEditHandle, fromCF, toCF, idx + loglen, len - loglen);

+    end;

+  end

+  else if (cf.dwEffects and fromCF.dwEffects) = fromCF.dwEffects then

+    SendMessage(RichEditHandle, EM_SETCHARFORMAT, SCF_SELECTION, LPARAM(@toCF));

+end;

+

+procedure ReplaceCharFormat(RichEditHandle: THANDLE; const fromCF, toCF: CHARFORMAT2);

+begin

+  ReplaceCharFormatRange(RichEditHandle,fromCF,toCF,0,GetTextLength(RichEditHandle));

+end;

+

+

+function GetTextRange(RichEditHandle: THANDLE; cpMin,cpMax: Integer): PWideChar;

+var

+  tr: TextRangeW;

+begin

+  tr.chrg.cpMin := cpMin;

+  tr.chrg.cpMax := cpMax;

+  GetMem(Result,(cpMax-cpMin+1)*SizeOf(WideChar));

+  tr.lpstrText := Result;

+

+  SendMessageW(RichEditHandle,EM_GETTEXTRANGE,0,LPARAM(@tr));

+end;

+

+{ Direct Bitmap to RTF insertion }

+

+function BytesPerScanline(PixelsPerScanline, BitsPerPixel, Alignment: Longint): Longint;

+begin

+  Dec(Alignment);

+  Result := ((PixelsPerScanline * BitsPerPixel) + Alignment) and not Alignment;

+  Result := Result div 8;

+end;

+

+procedure InitializeBitmapInfoHeader(Bitmap: HBITMAP; var BI: TBitmapInfoHeader; Colors: Integer);

+var

+  DS: TDIBSection;

+  Bytes: Integer;

+begin

+  DS.dsbmih.biSize := 0;

+  Bytes := GetObject(Bitmap, SizeOf(DS), @DS);

+  if Bytes = 0 then {InvalidBitmap}

+  else if (Bytes >= (sizeof(DS.dsbm) + sizeof(DS.dsbmih))) and

+    (DS.dsbmih.biSize >= DWORD(sizeof(DS.dsbmih))) then

+    BI := DS.dsbmih

+  else

+  begin

+    FillChar(BI, sizeof(BI), 0);

+    with BI, DS.dsbm do

+    begin

+      biSize := SizeOf(BI);

+      biWidth := bmWidth;

+      biHeight := bmHeight;

+    end;

+  end;

+  case Colors of

+    2: BI.biBitCount := 1;

+    3..16:

+      begin

+        BI.biBitCount := 4;

+        BI.biClrUsed := Colors;

+      end;

+    17..256:

+      begin

+        BI.biBitCount := 8;

+        BI.biClrUsed := Colors;

+      end;

+  else

+    BI.biBitCount := DS.dsbm.bmBitsPixel * DS.dsbm.bmPlanes;

+  end;

+  BI.biPlanes := 1;

+  if BI.biClrImportant > BI.biClrUsed then

+    BI.biClrImportant := BI.biClrUsed;

+  if BI.biSizeImage = 0 then

+    BI.biSizeImage := BytesPerScanLine(BI.biWidth, BI.biBitCount, 32) * Abs(BI.biHeight);

+end;

+

+procedure InternalGetDIBSizes(Bitmap: HBITMAP; var InfoHeaderSize: DWORD;

+  var ImageSize: DWORD; Colors: Integer);

+var

+  BI: TBitmapInfoHeader;

+begin

+  InitializeBitmapInfoHeader(Bitmap, BI, Colors);

+  if BI.biBitCount > 8 then

+  begin

+    InfoHeaderSize := SizeOf(TBitmapInfoHeader);

+    if (BI.biCompression and BI_BITFIELDS) <> 0 then

+      Inc(InfoHeaderSize, 12);

+  end

+  else

+    if BI.biClrUsed = 0 then

+      InfoHeaderSize := SizeOf(TBitmapInfoHeader) +

+        SizeOf(TRGBQuad) * (1 shl BI.biBitCount)

+    else

+      InfoHeaderSize := SizeOf(TBitmapInfoHeader) +

+        SizeOf(TRGBQuad) * BI.biClrUsed;

+  ImageSize := BI.biSizeImage;

+end;

+

+procedure GetDIBSizes(Bitmap: HBITMAP; var InfoHeaderSize: DWORD; var ImageSize: DWORD);

+begin

+  InternalGetDIBSizes(Bitmap, InfoHeaderSize, ImageSize, 0);

+end;

+

+function InternalGetDIB(Bitmap: HBITMAP; Palette: HPALETTE;

+  var BitmapInfo; var Bits; Colors: Integer): Boolean;

+var

+  OldPal: HPALETTE;

+  DC: HDC;

+begin

+  InitializeBitmapInfoHeader(Bitmap, TBitmapInfoHeader(BitmapInfo), Colors);

+  OldPal := 0;

+  DC := CreateCompatibleDC(0);

+  try

+    if Palette <> 0 then

+    begin

+      OldPal := SelectPalette(DC, Palette, False);

+      RealizePalette(DC);

+    end;

+    Result := GetDIBits(DC, Bitmap, 0, TBitmapInfoHeader(BitmapInfo).biHeight, @Bits,

+      TBitmapInfo(BitmapInfo), DIB_RGB_COLORS) <> 0;

+  finally

+    if OldPal <> 0 then SelectPalette(DC, OldPal, False);

+    DeleteDC(DC);

+  end;

+end;

+

+function GetDIB(Bitmap: HBITMAP; Palette: HPALETTE; var BitmapInfo; var Bits): Boolean;

+begin

+  Result := InternalGetDIB(Bitmap, Palette, BitmapInfo, Bits, 0);

+end;

+

+const

+  HexDigitChr: array [0..15] of AnsiChar = ('0','1','2','3','4','5','6','7',

+                                            '8','9','A','B','C','D','E','F');

+

+function BitmapToRTF(pict: HBITMAP): pAnsiChar;

+const

+  prefix  = '{\rtf1 {\pict\dibitmap ';

+  postfix = ' }}';

+var

+  tmp, bi, bb, rtf: pAnsiChar;

+  bis, bbs: cardinal;

+  len,cnt: integer;

+begin

+  GetDIBSizes(pict, bis, bbs);

+  GetMem(bi, bis);

+  GetMem(bb, bbs);

+  GetDIB(pict, {pict.Palette}0, bi^, bb^);

+

+  len:=(bis+bbs)*2+cardinal(Length(prefix)+Length(postfix))+1;

+  GetMem(result,len);

+

+  rtf:=StrCopyE(result,prefix);

+  tmp:=bi;

+  for cnt := 0 to bis-1 do

+  begin

+    rtf^ := HexDigitChr[ord(tmp^) shr  4]; inc(rtf);

+    rtf^ := HexDigitChr[ord(tmp^) and $F]; inc(rtf);

+    inc(tmp);

+  end;

+  tmp:=bb;

+  for cnt := 0 to bbs-1 do

+  begin

+    rtf^ := HexDigitChr[ord(tmp^) shr  4]; inc(rtf);

+    rtf^ := HexDigitChr[ord(tmp^) and $F]; inc(rtf);

+    inc(tmp);

+  end;

+  StrCopy(rtf,postfix);

+

+  FreeMem(bi);

+  FreeMem(bb);

+end;

+

+

+initialization

+finalization

+

+end.