⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 rvuni.pas

📁 richview1.7 full.source
💻 PAS
📖 第 1 页 / 共 3 页
字号:
🔍
123 
        exit;
      end;
      if PDx<>nil then begin
        PDx[0] := sz.cx;
        inc(PChar(PDx), sizeof(Integer));
      end;
    end;
    Fit := Length(s) div 2;
    end
  else begin
    {$IFNDEF RICHVIEWDEF4}
    if PDx=nil then begin
      GetMem(PDx, (Length(s) div 2 +1)*sizeof(Integer));
      allocated := True;
    end;
    {$ENDIF}
    GetTextExtentExPointW(Canvas.Handle, Pointer(s), Length(s) div 2, MaxExtent,
                            {$IFDEF RICHVIEWDEF4}
                            @Fit, PInteger(PDx),
                            {$ELSE}
                            Fit, PInteger(PDx)^,
                            {$ENDIF}
                            sz);
  end;
  {$IFNDEF RICHVIEWDEF4}
  if allocated then
    FreeMem(PDx);
  {$ENDIF}
end;
{------------------------------------------------------------------------------}
procedure RVU_GetTextExtentExPointPC(Canvas: TCanvas; pc: PChar; Length: Integer;
                                  MaxExtent: Integer; var Fit: Integer;
                                  PDx: PRVIntegerArray;
                                  ItemOptions: TRVItemOptions;
                                  var sz: TSize);
var i: Integer;
  {$IFNDEF RICHVIEWDEF4}
    allocated: Boolean;
  {$ENDIF}
begin
  if Length=0 then begin
    Fit := 0;
    exit;
  end;
  {$IFNDEF RICHVIEWDEF4}
  allocated := False;
  {$ENDIF}  
  if not (rvioUnicode in ItemOptions) then begin
    {$IFNDEF RICHVIEWDEF4}
    if PDx=nil then begin
      GetMem(PDx, (Length+1)*sizeof(Integer));
      allocated := True;
    end;
    {$ENDIF}
    GetTextExtentExPointA(Canvas.Handle,  pc, Length, MaxExtent,
                            {$IFDEF RICHVIEWDEF4}
                            @Fit, PInteger(PDx),
                            {$ELSE}
                            Fit, PInteger(PDx)^,
                            {$ENDIF}
                            sz);
    end
  else if not (RVNT) then begin
    for i := 1 to Length do begin
      GetTextExtentPoint32W(Canvas.Handle, Pointer(pc), i, sz);
      if sz.cx>MaxExtent then begin
        Fit := i-1;
        exit;
      end;
      if PDx<>nil then begin
        PDx[0] := sz.cx;
        inc(PChar(PDx), sizeof(Integer));
      end;
    end;
    Fit := Length;
    end
  else begin
    {$IFNDEF RICHVIEWDEF4}
    if PDx=nil then begin
      GetMem(PDx, (Length+1)*sizeof(Integer));
      allocated := True;
    end;
    {$ENDIF}
    GetTextExtentExPointW(Canvas.Handle, Pointer(pc), Length, MaxExtent,
                            {$IFDEF RICHVIEWDEF4}
                            @Fit, PInteger(PDx),
                            {$ELSE}
                            Fit, PInteger(PDx)^,
                            {$ENDIF}
                            sz);
  end;
  {$IFNDEF RICHVIEWDEF4}
  if allocated then
    FreeMem(PDx);
  {$ENDIF}
end;
{------------------------------------------------------------------------------}
function RVU_Length(const s: String; ItemOptions: TRVItemOptions): Integer;
begin
  if not (rvioUnicode in ItemOptions) then
    Result := Length(s)
  else
    Result := Length(s) div 2;
end;
{------------------------------------------------------------------------------}
function RVU_TextWidth(const s: String; Canvas: TCanvas;
                       ItemOptions: TRVItemOptions): Integer;
var Size: TSize;
begin
  if not (rvioUnicode in ItemOptions) then
    GetTextExtentPoint32A(Canvas.Handle, PChar(s), Length(s), Size)
  else
    GetTextExtentPoint32W(Canvas.Handle, Pointer(PChar(s)), Length(s) div 2, Size);
  Result := Size.cx;
end;
{------------------------------------------------------------------------------}
function RVU_IsSpace(const s: String; Index: Integer;
                     ItemOptions: TRVItemOptions): Boolean;
begin
  if not (rvioUnicode in ItemOptions) then
    Result := s[Index]=' '
  else
    Result := (s[(Index-1)*2+1]=' ') and (s[Index*2]=#0);
end;
{------------------------------------------------------------------------------}
procedure RVU_Delete(var s: String; Index, Count: Integer; ItemOptions: TRVItemOptions);
begin
  if not (rvioUnicode in ItemOptions) then
    Delete(s, Index, Count)
  else
    Delete(s, (Index-1)*2+1, Count*2);
end;
{------------------------------------------------------------------------------}
procedure RVU_Insert(const Source: String; var s: String; Index: Integer; ItemOptions: TRVItemOptions);
begin
  if not (rvioUnicode in ItemOptions) then
    Insert(Source, s, Index)
  else
    Insert(Source, s, (Index-1)*2+1);
end;
{------------------------------------------------------------------------------}
function RVU_OffsInPChar(Offs: Integer; ItemOptions: TRVItemOptions): Integer;
begin
  if not (rvioUnicode in ItemOptions) then
    Result := Offs
  else
    Result := Offs*2;
end;
{------------------------------------------------------------------------------}
{$ELSE}
{------------------------------------------------------------------------------}
function RVU_Copy(const s: String; Index, Count: Integer; ItemOptions: TRVItemOptions): String;
begin
  Result := Copy(s, Index, Count);
end;
{------------------------------------------------------------------------------}
procedure RVU_GetTextExtentExPoint(Canvas: TCanvas; const s: String;
                                  MaxExtent: Integer; var Fit: Integer;
                                  PDx: PRVIntegerArray;
                                  ItemOptions: TRVItemOptions);
var sz: TSize;
{$IFNDEF RICHVIEWDEF4}
    allocated: Boolean;
{$ENDIF}
begin
  if Length(s)=0 then begin
    Fit := 0;
    exit;
  end;
  {$IFNDEF RICHVIEWDEF4}
  if PDx=nil then begin
    GetMem(PDx, (Length+1)*sizeof(Integer));
    allocated := True;
    end
  else
    allocated := False;
  {$ENDIF}
  GetTextExtentExPointA(Canvas.Handle,  PChar(s), Length(s), MaxExtent,
                            {$IFDEF RICHVIEWDEF4}
                            @Fit, PInteger(PDx),
                            {$ELSE}
                            Fit, PInteger(PDx)^,
                            {$ENDIF}
                            sz);
  {$IFNDEF RICHVIEWDEF4}
  if allocated then
    FreeMem(PDx);
  {$ENDIF}
end;
{------------------------------------------------------------------------------}
procedure RVU_GetTextExtentExPointPC(Canvas: TCanvas; pc: PChar;
                                  Length: Integer;
                                  MaxExtent: Integer; var Fit: Integer;
                                  PDx: PRVIntegerArray;
                                  ItemOptions: TRVItemOptions;
                                  var sz: TSize);

{$IFNDEF RICHVIEWDEF4}
var
    allocated: Boolean;
{$ENDIF}
begin
  if Length=0 then begin
    Fit := 0;
    exit;
  end;
  {$IFNDEF RICHVIEWDEF4}
  if PDx=nil then begin
    GetMem(PDx, (Length+1)*sizeof(Integer));
    allocated := True;
    end
  else
    allocated := False;
  {$ENDIF}
  GetTextExtentExPointA(Canvas.Handle,  pc, Length, MaxExtent,
                            {$IFDEF RICHVIEWDEF4}
                            @Fit, PInteger(PDx),
                            {$ELSE}
                            Fit, PInteger(PDx)^,
                            {$ENDIF}
                            sz);
  {$IFNDEF RICHVIEWDEF4}
  if allocated then
    FreeMem(PDx);
  {$ENDIF}
end;
{------------------------------------------------------------------------------}
function RVU_Length(const s: String; ItemOptions: TRVItemOptions): Integer;
begin
  Result := Length(s);
end;
{------------------------------------------------------------------------------}
function RVU_TextWidth(const s: String; Canvas: TCanvas;
                       ItemOptions: TRVItemOptions): Integer;
var Size: TSize;
begin
  GetTextExtentPoint32(Canvas.Handle, PChar(s), Length(s), Size);
  Result := Size.cx;
end;
{------------------------------------------------------------------------------}
function RVU_IsSpace(const s: String; Index: Integer;
                     ItemOptions: TRVItemOptions): Boolean;
begin
  Result := s[Index]=' ';
end;
{------------------------------------------------------------------------------}
procedure RVU_Delete(var s: String; Index, Count: Integer; ItemOptions: TRVItemOptions);
begin
  Delete(s, Index, Count);
end;
{------------------------------------------------------------------------------}
procedure RVU_Insert(const Source: String; var s: String; Index: Integer; ItemOptions: TRVItemOptions);
begin
  Insert(Source, s, Index);
end;
{------------------------------------------------------------------------------}
function RVU_OffsInPChar(Offs: Integer; ItemOptions: TRVItemOptions): Integer;
begin
  Result := Offs;
end;
{$ENDIF}
{------------------------------------------------------------------------------}
function RVU_DrawSelectedTextEx(Left, Top, Height: Integer; const s: String; Canvas: TCanvas; Index1,Index2: Integer;
                                ItemOptions: TRVItemOptions;
                                BiDiMode: TRVBiDiMode): Boolean;
begin
  if BiDiMode=rvbdUnspecified then
    Result := False
  else
    Result := RVU_DrawSelectedTextEx_(Left, Top, Height, s, Canvas, Index1,Index2, ItemOptions);
end;
{------------------------------------------------------------------------------}
{$IFDEF RICHVIEWCBDEF3}
function RVU_Charset2CodePage(Charset: TFontCharset): TRVCodePage;
begin
  // PLEASE REPORT ME ABOUT ERRORS IN THIS TABLE
  case Charset of
    DEFAULT_CHARSET:
      Result := CP_ACP;
    OEM_CHARSET:
       Result := CP_OEMCP;
    MAC_CHARSET:
       Result := CP_MACCP;
    SYMBOL_CHARSET:
      Result := CP_ACP; // ???
    VIETNAMESE_CHARSET:
       Result := 1258;
    ANSI_CHARSET:
      Result := 1252;   // Windows 3.1 US (ANSI)
    SHIFTJIS_CHARSET:
       Result := 932;   // Japan
    HANGEUL_CHARSET:
       Result := 949;   // Korean
    JOHAB_CHARSET:
       Result := 1361;  // Korean (Johab)
    GB2312_CHARSET:
       Result := 936;   // Chinese (PRC, Singapore)
    CHINESEBIG5_CHARSET:
       Result := 950;   // Chinese (Taiwan, Hong Kong)
    GREEK_CHARSET:
       Result := 1253;  // Windows 3.1 Greek
    TURKISH_CHARSET:
       Result := 1254;  // Windows 3.1 Turkish
    HEBREW_CHARSET:
       Result := 1255;   // Hebrew
    ARABIC_CHARSET:
       Result := 1256;   // Arabic
    BALTIC_CHARSET:
       Result := 1257;   // Baltic
    RUSSIAN_CHARSET:
       Result := 1251;   // Windows 3.1 Cyrillic
    THAI_CHARSET:
       Result := 874;    // Thai
    EASTEUROPE_CHARSET:
       Result := 1250;   // Windows 3.1 Eastern European
    else
       Result := CP_ACP;
  end;
end;
{------------------------------------------------------------------------------}
function RVU_Charset2Language(Charset: TFontCharset): TRVCodePage;
begin
  // PLEASE REPORT ME ABOUT ERRORS IN THIS TABLE
  // Note: trying to make a best guess here;
  // one charset can be used by a lots of languages
  case Charset of
    DEFAULT_CHARSET:
      Result := $0400; // default
    OEM_CHARSET:
       Result := $0400; // default
    MAC_CHARSET:
       Result := $0400; // default
    SYMBOL_CHARSET:
      Result := $0400; // default
    VIETNAMESE_CHARSET:
       Result := $042A;  // by experement with MS Word
    ANSI_CHARSET:
      Result := $0400;   // default
    SHIFTJIS_CHARSET:
       Result := $0411;   // Japanese
    HANGEUL_CHARSET:
       Result := $0412;   // Korean
    JOHAB_CHARSET:
       Result := $0812;  // Korean (Johab)
    GB2312_CHARSET:
       Result := $0804;   // Chinese (PRC; more options possible here)
    CHINESEBIG5_CHARSET:
       Result := $0404;	  // Chinese (Taiwan; more options possible here)
    GREEK_CHARSET:
       Result := $0408;  // Greek
    TURKISH_CHARSET:
       Result := $041F;  // Turkish
    HEBREW_CHARSET:
       Result := $040D;  // Hebrew
    ARABIC_CHARSET:
       Result := $0400;	 // default - too many options
    BALTIC_CHARSET:
       Result := $0400;  // default - too many options
    RUSSIAN_CHARSET:
       Result := $0419;   // Russian
    THAI_CHARSET:
       Result := $041E;    // Thai
    EASTEUROPE_CHARSET:
       Result := $0400;   // default - too many options
    else
       Result := $0400;
  end;
end;
{------------------------------------------------------------------------------}
function RVU_RawUnicodeToWideString(const s: String):WideString;
begin
  RVCheckUni(Length(s));
  SetLength(Result, Length(s) div 2);
  Move(Pointer(s)^, Pointer(Result)^, Length(s));
end;
{------------------------------------------------------------------------------}
function RVU_GetRawUnicode(const s: WideString):String;
begin
  SetLength(Result, Length(s)*2);
  Move(Pointer(s)^, Pointer(Result)^, Length(Result));
end;
{$ELSE}
{------------------------------------------------------------------------------}
function RVU_GetRawUnicode(const s: String):String;
begin
  Result := s;
end;
{$ENDIF}
{------------------------------------------------------------------------------}
procedure RVU_SwapWordBytes(arr: PWord; Count: Integer);
var i: Integer;
begin
  for i := 0 to Count-1 do begin
    arr^ := Swap(Word(arr^));
    inc(PChar(arr),2);
  end;
end;
{------------------------------------------------------------------------------}
function RVU_AnsiToUnicode(CodePage: TRVCodePage; const s: String): String;
var l: Integer;
begin
  if Length(s)=0 then begin
    Result := '';
    exit;
  end;
  l := MultiByteToWideChar(CodePage,MB_PRECOMPOSED or MB_USEGLYPHCHARS, PChar(s), Length(s),
                           nil, 0);
  if (l=0) and (CodePage<>CP_ACP) then begin
    CodePage := CP_ACP;
    l := MultiByteToWideChar(CodePage, MB_PRECOMPOSED or MB_USEGLYPHCHARS, PChar(s), Length(s),
                           nil, 0);
  end;
  if l<>0 then begin
    SetLength(Result, l*2);
    MultiByteToWideChar(CodePage, MB_PRECOMPOSED or MB_USEGLYPHCHARS, PChar(s), Length(s),
                             Pointer(Result), l);
    end
  else begin
    SetLength(Result, Length(s)*2);
    FillChar(PChar(Result)^, Length(Result), 0);
123

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -