/components/synedit/syneditmiscprocs.pp

http://github.com/graemeg/lazarus · Puppet · 258 lines · 211 code · 47 blank · 0 comment · 29 complexity · 0343b4e9aa0f6f8d5ab7f3d4a3ac5b85 MD5 · raw file

  1. {-------------------------------------------------------------------------------
  2. The contents of this file are subject to the Mozilla Public License
  3. Version 1.1 (the "License"); you may not use this file except in compliance
  4. with the License. You may obtain a copy of the License at
  5. http://www.mozilla.org/MPL/
  6. Software distributed under the License is distributed on an "AS IS" basis,
  7. WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
  8. the specific language governing rights and limitations under the License.
  9. The Original Code is: SynEditMiscProcs.pas, released 2000-04-07.
  10. The Original Code is based on the mwSupportProcs.pas file from the
  11. mwEdit component suite by Martin Waldenburg and other developers, the Initial
  12. Author of this file is Michael Hieke.
  13. All Rights Reserved.
  14. Contributors to the SynEdit and mwEdit projects are listed in the
  15. Contributors.txt file.
  16. Alternatively, the contents of this file may be used under the terms of the
  17. GNU General Public License Version 2 or later (the "GPL"), in which case
  18. the provisions of the GPL are applicable instead of those above.
  19. If you wish to allow use of your version of this file only under the terms
  20. of the GPL and not to allow others to use your version of this file
  21. under the MPL, indicate your decision by deleting the provisions above and
  22. replace them with the notice and other provisions required by the GPL.
  23. If you do not delete the provisions above, a recipient may use your version
  24. of this file under either the MPL or the GPL.
  25. $Id$
  26. You may retrieve the latest version of this file at the SynEdit home page,
  27. located at http://SynEdit.SourceForge.net
  28. Known Issues:
  29. -------------------------------------------------------------------------------}
  30. unit SynEditMiscProcs;
  31. {$I synedit.inc}
  32. interface
  33. uses
  34. LCLIntf, LCLType, Classes, SynEditTypes, Graphics;
  35. type
  36. PIntArray = ^TIntArray;
  37. TIntArray = array[0..MaxListSize - 1] of integer;
  38. function MulDiv(Factor1,Factor2,Divisor:integer):integer;{$IFDEF HasInline}inline;{$ENDIF}
  39. function Max(x, y: integer): integer;{$IFDEF HasInline}inline;{$ENDIF}
  40. function Min(x, y: integer): integer;{$IFDEF HasInline}inline;{$ENDIF}
  41. function MinMax(x, mi, ma: integer): integer;{$IFDEF HasInline}inline;{$ENDIF}
  42. procedure SwapInt(var l, r: integer);{$IFDEF HasInline}inline;{$ENDIF}
  43. function maxPoint(P1, P2: TPoint): TPoint;
  44. function minPoint(P1, P2: TPoint): TPoint;
  45. function eqPoint(P1, P2: TPoint): Boolean;
  46. procedure SwapPoint(var P1, P2: TPoint);
  47. procedure InternalFillRect(dc: HDC; const rcPaint: TRect);
  48. // search for the first char of set AChars in Line, starting at index Start
  49. function StrScanForCharInSet(const Line: string; Start: integer;
  50. AChars: TSynIdentChars): integer;
  51. function GetEOL(Line: PChar): PChar;
  52. function CompareCarets(const FirstCaret, SecondCaret: TPoint): integer;
  53. function fsNot (s : TFontStyles) : TFontStyles; inline;
  54. function fsXor (s1,s2 : TFontStyles) : TFontStyles; inline;
  55. function CreateTabsAndSpaces(StartPos, SpaceLen, TabWidth: integer;
  56. UseTabs: boolean): string;
  57. procedure SynAssert(Condition: Boolean; Msg: String);
  58. procedure SynAssert(Condition: Boolean; Msg: String; Args: Array of Const);
  59. function ToIdx(APos: Integer): Integer; inline;
  60. function ToPos(AIdx: Integer): Integer; inline;
  61. implementation
  62. uses
  63. SysUtils;
  64. function ToIdx(APos: Integer): Integer; inline;
  65. begin
  66. Result := APos - 1;
  67. end;
  68. function ToPos(AIdx: Integer): Integer; inline;
  69. begin
  70. Result := AIdx + 1;
  71. end;
  72. {* fontstyle utilities *}
  73. function fsNot (s : TFontStyles) : TFontStyles; inline;
  74. begin
  75. Result := [low(TFontStyle)..High(TFontStyle)] - s;
  76. end;
  77. function fsXor (s1,s2 : TFontStyles) : TFontStyles; inline;
  78. begin
  79. Result := s1 + s2 - (s1*s2);
  80. end;
  81. {***}
  82. function MulDiv(Factor1,Factor2,Divisor:integer):integer;
  83. begin
  84. Result:=(int64(Factor1)*int64(Factor2)) div Divisor;
  85. end;
  86. function Max(x, y: integer): integer;
  87. begin
  88. if x > y then Result := x else Result := y;
  89. end;
  90. function Min(x, y: integer): integer;
  91. begin
  92. if x < y then Result := x else Result := y;
  93. end;
  94. function MinMax(x, mi, ma: integer): integer;
  95. begin
  96. if (x < mi) then Result := mi
  97. else if (x > ma) then Result := ma else Result := x;
  98. end;
  99. procedure SwapInt(var l, r: integer);
  100. var
  101. tmp: integer;
  102. begin
  103. tmp := r;
  104. r := l;
  105. l := tmp;
  106. end;
  107. function maxPoint(P1, P2: TPoint): TPoint;
  108. begin
  109. Result := P1;
  110. if (P2.y > P1.y) or ((P2.y = P1.y) and (P2.x > P1.x)) then
  111. Result := P2;
  112. end;
  113. function minPoint(P1, P2: TPoint): TPoint;
  114. begin
  115. Result := P1;
  116. if (P2.y < P1.y) or ((P2.y = P1.y) and (P2.x < P1.x)) then
  117. Result := P2;
  118. end;
  119. function eqPoint(P1, P2: TPoint): Boolean;
  120. begin
  121. Result := (P2.y = P1.y) and (P2.x = P1.x);
  122. end;
  123. procedure SwapPoint(var P1, P2: TPoint);
  124. var
  125. tmp : TPoint;
  126. begin
  127. tmp := P1;
  128. P1 := P2;
  129. P2 := tmp;
  130. end;
  131. procedure InternalFillRect(dc: HDC; const rcPaint: TRect);
  132. begin
  133. ExtTextOut(dc, 0, 0, ETO_OPAQUE, @rcPaint, nil, 0, nil);
  134. end;
  135. {***}
  136. function StrScanForCharInSet(const Line: string; Start: integer;
  137. AChars: TSynIdentChars): integer;
  138. var
  139. p: PChar;
  140. begin
  141. if (Start > 0) and (Start <= Length(Line)) then
  142. begin
  143. p := PChar(@Line[Start]);
  144. repeat
  145. if p^ in AChars then
  146. begin
  147. Result := Start;
  148. exit;
  149. end;
  150. Inc(p);
  151. Inc(Start);
  152. until p^ = #0;
  153. end;
  154. Result := 0;
  155. end;
  156. function GetEOL(Line: PChar): PChar;
  157. begin
  158. Result := Line;
  159. if Assigned(Result) then
  160. while not (Result^ in [#0, #10, #13]) do
  161. Inc(Result);
  162. end;
  163. function CompareCarets(const FirstCaret, SecondCaret: TPoint): integer;
  164. begin
  165. if (FirstCaret.Y<SecondCaret.Y) then
  166. Result:=1
  167. else if (FirstCaret.Y>SecondCaret.Y) then
  168. Result:=-1
  169. else if (FirstCaret.X<SecondCaret.X) then
  170. Result:=1
  171. else if (FirstCaret.X>SecondCaret.X) then
  172. Result:=-1
  173. else
  174. Result:=0;
  175. end;
  176. function CreateTabsAndSpaces(StartPos, SpaceLen, TabWidth: integer;
  177. UseTabs: boolean): string;
  178. var
  179. TabCount: Integer;
  180. EndPos: Integer;
  181. PosPlusOneTab: Integer;
  182. begin
  183. Result:='';
  184. if not UseTabs then begin
  185. Result:=StringOfChar(' ',SpaceLen);
  186. exit;
  187. end;
  188. TabCount:=0;
  189. EndPos:=StartPos+SpaceLen;
  190. while StartPos<EndPos do begin
  191. PosPlusOneTab:=StartPos+TabWidth-((StartPos-1) mod TabWidth);
  192. if PosPlusOneTab<=EndPos then begin
  193. inc(TabCount);
  194. StartPos:=PosPlusOneTab;
  195. end else begin
  196. Result:=StringOfChar(' ',EndPos-StartPos);
  197. break;
  198. end;
  199. end;
  200. if TabCount>0 then
  201. Result:=StringOfChar(#9,TabCount)+Result;
  202. end;
  203. procedure SynAssert(Condition: Boolean; Msg: String);
  204. begin
  205. if not Condition then raise Exception.Create(Msg);
  206. end;
  207. procedure SynAssert(Condition: Boolean; Msg: String; Args: array of const);
  208. begin
  209. if not Condition then raise Exception.Create(Format(Msg, Args));
  210. end;
  211. end.