syneditmiscprocs.pas

DBDesigner 4 is a database design system that integrates database design, modelling, creation and ma

  nW: integer;
begin
  nW := 2;
  repeat
    if (nW >= TabWidth) then break;
    Inc(nW, nW);
  until (nW >= $10000);  // we don't want 64 kByte spaces...
  Result := (nW = TabWidth);
end;

function GetBestConvertTabsProc(TabWidth: integer): TConvertTabsProc;
begin
  if (TabWidth < 2) then Result := TConvertTabsProc(@ConvertTabs1)
    else if IsPowerOfTwo(TabWidth) then
      Result := TConvertTabsProc(@ConvertTabs2n)
    else
      Result := TConvertTabsProc(@ConvertTabs);
end;

function GetBestConvertTabsProcEx(TabWidth: integer): TConvertTabsProcEx;
begin
  if (TabWidth < 2) then Result := TConvertTabsProcEx(@ConvertTabs1Ex)
    else if IsPowerOfTwo(TabWidth) then
      Result := TConvertTabsProcEx(@ConvertTabs2nEx)
    else
      Result := TConvertTabsProcEx(@ConvertTabsEx);
end;
{end}                                                                           //mh 2000-10-19

{***}

function CharIndex2CaretPos(Index, TabWidth: integer;
  const Line: string): integer;
var
  iChar: integer;
  pNext: PChar;
begin
// possible sanity check here: Index := Max(Index, Length(Line));
  if Index > 1 then begin
    if (TabWidth <= 1) or not GetHasTabs(pointer(Line), iChar) then
      Result := Index
    else begin
      if iChar + 1 >= Index then
        Result := Index
      else begin
        // iChar is number of chars before first #9
        Result := iChar;
        // Index is *not* zero-based
        Inc(iChar);
        Dec(Index, iChar);
        pNext := @Line[iChar];
        while Index > 0 do begin
          case pNext^ of
            #0: break;
            #9: begin
                  // Result is still zero-based
                  Inc(Result, TabWidth);
                  Dec(Result, Result mod TabWidth);
                end;
            else Inc(Result);
          end;
          Dec(Index);
          Inc(pNext);
        end;
        // done with zero-based computation
        Inc(Result);
      end;
    end;
  end else
    Result := 1;
end;

function CaretPos2CharIndex(Position, TabWidth: integer; const Line: string;
  var InsideTabChar: boolean): integer;
var
  iPos: integer;
  pNext: PChar;
begin
  InsideTabChar := FALSE;
  if Position > 1 then begin
    if (TabWidth <= 1) or not GetHasTabs(pointer(Line), iPos) then
      Result := Position
    else begin
      if iPos + 1 >= Position then
        Result := Position
      else begin
        // iPos is number of chars before first #9
        Result := iPos + 1;
        pNext := @Line[Result];
        // for easier computation go zero-based (mod-operation)
        Dec(Position);
        while iPos < Position do begin
          case pNext^ of
            #0: break;
            #9: begin
                  Inc(iPos, TabWidth);
                  Dec(iPos, iPos mod TabWidth);
                  if iPos > Position then begin
                    InsideTabChar := TRUE;
                    break;
                  end;
                end;
            else Inc(iPos);
          end;
          Inc(Result);
          Inc(pNext);
        end;
      end;
    end;
  end else
    Result := Position;
end;

function StrScanForCharInSet(const Line: string; Start: integer;
  AChars: TSynIdentChars): integer;
var
  p: PChar;
begin
  if (Start > 0) and (Start <= Length(Line)) then
  begin
{$IFDEF SYN_MBCSSUPPORT}
    // don't start on a trail byte
    if ByteType(Line, Start) = mbTrailByte then
    begin
      Inc(Start);
      if Start > Length(Line) then
      begin
        Result := 0;
        Exit;
      end;
    end;
{$ENDIF}
    p := PChar(@Line[Start]);
    repeat
{$IFDEF SYN_MBCSSUPPORT}
      // skip over multibyte characters
      if p^ in LeadBytes then
      begin
        Inc(p);
        Inc(Start);
        if p^ = #0 then
          Break;
      end
      else
{$ENDIF}
      if p^ in AChars then
      begin
        Result := Start;
        exit;
      end;
      Inc(p);
      Inc(Start);
    until p^ = #0;
  end;
  Result := 0;
end;

function StrRScanForCharInSet(const Line: string; Start: integer;
  AChars: TSynIdentChars): integer;
var
  I: Integer;
begin
  Result := 0;
  if (Start > 0) and (Start <= Length(Line)) then begin
{$IFDEF SYN_MBCSSUPPORT}
    if not SysLocale.FarEast then begin
{$ENDIF}
      for I := Start downto 1 do
        if Line[I] in AChars then begin
          Result := I;
          Exit;
        end;
{$IFDEF SYN_MBCSSUPPORT}
    end
    else begin
      // it's a lot faster to start from the beginning and go forward than to go
      // backward and call ByteType on every character
      I := 1;
      while I <= Start do begin
        if Line[I] in LeadBytes then
          Inc(I)
        else if Line[I] in AChars then
          Result := I;
        Inc(I);
      end;
    end;
{$ENDIF}
  end;
end;

{$IFDEF SYN_MBCSSUPPORT}
function StrScanForMultiByteChar(const Line: string; Start: Integer): Integer;
var
  I: Integer;
begin
  if SysLocale.FarEast and (Start > 0) and (Start <= Length(Line)) then begin
    // don't start on a trail byte
    if ByteType(Line, Start) = mbTrailByte then
      Inc(Start);
    for I := Start to Length(Line) do
      if Line[I] in LeadBytes then begin
        Result := I;
        Exit;
      end;
  end;
  Result := 0;
end;
{$ENDIF}

{$IFDEF SYN_MBCSSUPPORT}
function StrRScanForMultiByteChar(const Line: string; Start: Integer): Integer;
var
  I: Integer;
begin
  Result := 0;
  if SysLocale.FarEast and (Start > 0) and (Start <= Length(Line)) then begin
    // it's a lot faster to start from the beginning and go forward than to go
    // backward and call ByteType on every character
    I := 1;
    while I <= Start do begin
      if Line[I] in LeadBytes then begin
        Result := I;
        Inc(I);
      end;
      Inc(I);
    end;
  end;
end;
{$ENDIF}

function GetEOL(Line: PChar): PChar;
begin
  Result := Line;
  if Assigned(Result) then
    while not (Result^ in [#0, #10, #13]) do
      Inc(Result);
end;

{begin}                                                                         //gp 2000-06-24
{$IFOPT R+}{$DEFINE RestoreRangeChecking}{$ELSE}{$UNDEF RestoreRangeChecking}{$ENDIF}
{$R-}
function EncodeString(s: string): string;
var
  i, j: integer;
begin
  SetLength(Result, 2 * Length(s)); // worst case
  j := 0;
  for i := 1 to Length(s) do begin
    Inc(j);
    if s[i] = '\' then begin
      Result[j] := '\';
      Result[j + 1] := '\';
      Inc(j);
    end else if s[i] = '/' then begin
      Result[j] := '\';
      Result[j + 1] := '.';
      Inc(j);
    end else
      Result[j] := s[i];
  end; //for
  SetLength(Result, j);
end; { EncodeString }

function DecodeString(s: string): string;
var
  i, j: integer;
begin
  SetLength(Result, Length(s)); // worst case
  j := 0;
  i := 1;
  while i <= Length(s) do begin
    Inc(j);
    if s[i] = '\' then begin
      Inc(i);
      if s[i] = '\' then
        Result[j] := '\'
      else
        Result[j] := '/';
    end else
      Result[j] := s[i];
    Inc(i);
  end; //for
  SetLength(Result,j);
end; { DecodeString }
{$IFDEF RestoreRangeChecking}{$R+}{$ENDIF}
{end}                                                                           //gp 2000-06-24

{$IFNDEF SYN_COMPILER_5_UP}
procedure FreeAndNil(var Obj);
var
  P: TObject;
begin
  P := TObject(Obj);
  TObject(Obj) := nil;
  P.Free;
end;
{$ENDIF}

{$IFNDEF SYN_COMPILER_3_UP}
procedure Assert(Expr: Boolean);  { stub for Delphi 2 }
begin
end;
{$ENDIF}


{$IFNDEF SYN_COMPILER_3_UP}
function LastDelimiter(const Delimiters, S: string): Integer;
var
  P: PChar;
begin
  Result := Length(S);
  P := PChar(Delimiters);
  while Result > 0 do
  begin
    if (S[Result] <> #0) and (StrScan(P, S[Result]) <> nil) then
{$IFDEF SYN_MBCSSUPPORT}
      if (ByteType(S, Result) = mbTrailByte) then
        Dec(Result)
      else
{$ENDIF}
        Exit;
{$IFDEF SYN_KYLIX}
    begin
      if (ByteType(S, Result) <> mbTrailByte) then
        Exit;
      Dec(Result);
      while ByteType(S, Result) = mbTrailByte do
        Dec(Result);
    end;
{$ENDIF}
    Dec(Result);
  end;
end;
{$ENDIF}

{$IFNDEF SYN_COMPILER_4_UP}
function StringReplace(const S, OldPattern, NewPattern: string;
  Flags: TReplaceFlags): string;
var
  SearchStr, Patt, NewStr: string;
  Offset: Integer;
begin
  if rfIgnoreCase in Flags then
  begin
    SearchStr := AnsiUpperCase(S);
    Patt := AnsiUpperCase(OldPattern);
  end else
  begin
    SearchStr := S;
    Patt := OldPattern;
  end;
  NewStr := S;
  Result := '';
  while SearchStr <> '' do
  begin
    {$IFDEF SYN_COMPILER_3_UP}
    Offset := AnsiPos(Patt, SearchStr);
    {$ELSE}
    Offset := Pos(Patt, SearchStr);     // Pos does not support MBCS
    {$ENDIF}
    if Offset = 0 then
    begin
      Result := Result + NewStr;
      Break;
    end;
    Result := Result + Copy(NewStr, 1, Offset - 1) + NewPattern;
    NewStr := Copy(NewStr, Offset + Length(OldPattern), MaxInt);
    if not (rfReplaceAll in Flags) then
    begin
      Result := Result + NewStr;
      Break;
    end;
    SearchStr := Copy(SearchStr, Offset + Length(Patt), MaxInt);
  end;
end;
{$ENDIF}

{$IFDEF SYN_CLX}
type
  TColorRec = packed record
    Blue: Byte;
    Green: Byte;
    Red: Byte;
    Unused: Byte;
  end;

function GetRValue(RGBValue: TColor): byte;
begin
  Result := TColorRec(RGBValue).Red;
end;

function GetGValue(RGBValue: TColor): byte;
begin
  Result := TColorRec(RGBValue).Green;
end;

function GetBValue(RGBValue: TColor): byte;
begin
  Result := TColorRec(RGBValue).Blue;
end;
{$ENDIF}

end.