Janilabo

Untitled

Aug 15th, 2012
57
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Pascal 1.40 KB | None | 0 0
  1. procedure TPAUnique(var TPA: TPointArray);
  2. var
  3.   h, h2, i, i2, i3, d: Integer;
  4. begin
  5.   h := High(TPA);
  6.   if (h < 1) then
  7.     Exit;
  8.   for i := (h - d) downto 1 do
  9.     for i2 := (i - 1) downto 0 do
  10.       if ((TPA[i].X = TPA[i2].X) and (TPA[i].Y = TPA[i2].Y)) then
  11.       begin
  12.         h2 := High(TPA);
  13.         for i3 := i to (h2 - 1) do
  14.           TPA[i3] := TPA[(i3 + 1)];
  15.         SetLength(TPA, h2);
  16.         Inc(d);
  17.         Break;
  18.       end;
  19. end;
  20.  
  21. function FindColorsMulti(colors: TIntegerArray; xs, ys, xe, ye: Integer): TPointArray;
  22. var
  23.   l, i: Integer;
  24.   ATPA: T2DPointArray;
  25. begin
  26.   ClearSameIntegers(colors);
  27.   l := Length(colors);
  28.   if (l < 1) then
  29.     Exit;
  30.   SetLength(ATPA, l);
  31.   for i := 0 to (l - 1) do
  32.     if ((colors[i] >= 0) and (colors[i] <= 16777215)) then
  33.       FindColors(ATPA[i], colors[i], xs, ys, xe, ye);
  34.   Result := MergeATPA(ATPA);
  35.   SetLength(ATPA, 0);
  36.   TPAUnique(Result);
  37. end;
  38.  
  39. var
  40.   i: Integer;
  41.   TPA: TPointArray;
  42.   ATPA: array of TPointArray;
  43.  
  44. begin
  45.   LoadFont('RSCMainFont', False);
  46.   ClearDebug;
  47.   ActivateClient;
  48.   Wait(2000);
  49.   i := GetSystemTime;
  50.   TPA := FindColorsMulti([16776960, 4231423, 65535, 65280, 16777215], 3, 2, 311, 18);
  51.   WriteLn(Length(TPA));
  52.   ATPA := SplitTPAEx(TPA, 1, 10);
  53.   SetLength(TPA, 0);
  54.   try
  55.     WriteLn(GetTextATPA(ATPA, 4, 'RSCMainFont'));
  56.   except
  57.   end;
  58.   SetLength(ATPA, 0);
  59.   FreeFont('RSCMainFont');
  60. end.
Advertisement
Add Comment
Please, Sign In to add comment