Школоло / Говнокод #21578 Ссылка на оригинал

0

  1. 1
  2. 2
  3. 3
  4. 4
  5. 5
  6. 6
  7. 7
  8. 8
  9. 9
  10. 10
  11. 11
  12. 12
  13. 13
  14. 14
  15. 15
  16. 16
  17. 17
  18. 18
  19. 19
  20. 20
  21. 21
  22. 22
  23. 23
  24. 24
  25. 25
  26. 26
  27. 27
  28. 28
  29. 29
  30. 30
  31. 31
  32. 32
  33. 33
  34. 34
  35. 35
  36. 36
  37. 37
  38. 38
  39. 39
  40. 40
  41. 41
  42. 42
  43. 43
  44. 44
  45. 45
  46. 46
  47. 47
  48. 48
  49. 49
  50. 50
  51. 51
  52. 52
  53. 53
  54. 54
  55. 55
  56. 56
  57. 57
  58. 58
  59. 59
  60. 60
  61. 61
  62. 62
  63. 63
  64. 64
  65. 65
  66. 66
  67. 67
  68. 68
  69. 69
  70. 70
  71. 71
  72. 72
  73. 73
  74. 74
  75. 75
  76. 76
procedure TALScrollingText.InvalidateEverything;
var
  i: Integer;
begin
  with WholeBitmap do
  begin
    Canvas.Brush.Color := fBackgroundColor;
    Canvas.FillRect(Rect(0, 0, Width, Height));
    Canvas.Font := Self.Font;
    Width := WholeBitmap.Canvas.TextWidth(fText) + (2 * Self.Width);
    Height := Self.Height;
    if (Self.Font.Color = clGreen) or (fBackgroundColor = clGreen) then
    begin
      TransparentColor := clRed;
      Canvas.Font.Color := clRed;
    end
    else
    begin
      TransparentColor := clGreen;
      Canvas.Font.Color := clGreen;
    end;
    if fLayout = tlTop then
      Canvas.TextOut(Self.Width, 0, fText)
    else if fLayout = tlCenter then
      Canvas.TextOut(Self.Width, (Self.Height div 2) - (Canvas.TextHeight(fText) div 2), fText)
    else
      Canvas.TextOut(Self.Width, Self.Height - Canvas.TextHeight(fText), fText);
  end;

  with BackBitmap do
  begin
    Width := Self.Width;
    Height := Self.Height;
    Canvas.Brush.Color := Self.Font.Color;
    Canvas.FillRect(Rect(0, 0, Self.Width, Self.Height));
    if fEdgeFadeWidth > 0 then
    begin
      for i := 0 to fEdgeFadeWidth-1 do
      begin
        Canvas.Pen.Color := CalcColorIndex(fBackgroundColor, Self.Font.Color, fEdgeFadeWidth, i+1);
        Canvas.MoveTo(i, 0);
        Canvas.LineTo(i, Self.Height);
        Canvas.MoveTo(Width-i-1, 0);
        Canvas.LineTo(Width-i-1, Self.Height);
      end;
    end;
  end;

  DrawnBitmap.Width := Width;
  DrawnBitmap.Height := Height;
end;

function TALScrollingText.CalcColorIndex(StartColor, EndColor: TColor; Steps, ColorIndex: Integer): TColor;
var
  BeginRGBValue: Array[0..2] of Byte;
  RGBDifference: Array[0..2] of Integer;
  Red, Green, Blue: Byte;
  NumColors: Integer;
begin
  if (ColorIndex < 1) or (ColorIndex > Steps) then
    raise ERangeError.Create('ColorIndex can''t be less than 1 or greater than ' + IntToStr(Steps));
  NumColors := Steps;
  Dec(ColorIndex);
  BeginRGBValue[0] := GetRValue(ColorToRGB(StartColor));
  BeginRGBValue[1] := GetGValue(ColorToRGB(StartColor));
  BeginRGBValue[2] := GetBValue(ColorToRGB(StartColor));
  RGBDifference[0] := GetRValue(ColorToRGB(EndColor)) - BeginRGBValue[0];
  RGBDifference[1] := GetGValue(ColorToRGB(EndColor)) - BeginRGBValue[1];
  RGBDifference[2] := GetBValue(ColorToRGB(EndColor)) - BeginRGBValue[2];

  // Calculate the bands color
  Red := BeginRGBValue[0] + MulDiv(ColorIndex, RGBDifference[0], NumColors - 1);
  Green := BeginRGBValue[1] + MulDiv(ColorIndex, RGBDifference[1], NumColors - 1);
  Blue := BeginRGBValue[2] + MulDiv(ColorIndex, RGBDifference[2], NumColors - 1);
  Result := RGB(Red, Green, Blue);
end;

Процедура для размытия концов бегущей строки.
Прикол в том, что шрифты, поддерживающие ClearType, приобретают зеленоватый оттенок.

Запостил: father__Muldoon father__Muldoon, (Updated )

Комментарии (1) RSS

Добавить комментарий

Я, guest, находясь в здравом уме и твердой памяти, торжественно заявляю:

    А не использовать ли нам bbcode?


    8