SRL Archive - Research & Development Lounge

Hey,

I made this for something I thought it would be useful for (Smartkid's Grapher). I figured I might as well post it here:

program New;

procedure LineTo_Alpha(Bitmap, Color, FromX, FromY, ToX, ToY: Integer; Alpha: Single);
var
  w, h, i,
  r1, g1, b1,
  r2, g2, b2,
  x, y: Integer;
  dx, dy, d: Extended;
begin
  ColorToRGB(Color, r1, g1, b1);

  GetBitmapSize(Bitmap, w, h);
  FromX := Max(Min(FromX, w), 0);
  ToX := Max(Min(ToX, w), 0);
  FromY := Max(Min(FromY, h), 0);
  ToY := Max(Min(ToY, h), 0);
  Alpha := MaxE(MinE(1.0, Alpha), 0);

  d := Sqrt(Sqr(FromX - ToX) + Sqr(FromY - ToY));
  dx := (ToX - FromX) / d;
  dy := (ToY - FromY) / d;

  for i := 0 to Ceil(d) do
  begin
    x := Round(i * dx) + FromX;
    y := Round(i * dy) + FromY;
    ColorToRGB(FastGetPixel(Bitmap, x, y), r2, g2, b2);
    FastSetPixel(Bitmap, x, y, RGBtoColor(
      Round(r1 * (1.0 - Alpha) + r2 * Alpha),
      Round(g1 * (1.0 - Alpha) + g2 * Alpha),
      Round(b1 * (1.0 - Alpha) + b2 * Alpha)));
  end;
end;

procedure RotatedText_Alpha(Bitmap, Color, tx, ty: Integer; Alpha, Angle: Single; Size: Integer; Face, Text: string);
var
  w, h, x, y,
  r1, g1, b1,
  r2, g2, b2: Integer;
  b, r: Integer;
begin
  ColorToRGB(Color, r1, g1, b1);

  b := BitmapFromString(Round(Size * Length(Text) * 1.5), Size * 3, '');
  with GetBitmapCanvas(b) do
  begin
    Font.Size := Size;
    Font.Name := Face;
    w := TextWidth(Text);
    h := TextHeight(Text);
  end;
  FreeBitmap(b);
  
  w := Max(w, h) shl 1;
  h := w shr 2;
  b := BitmapFromString(w, w, '');
  with GetBitmapCanvas(b) do
  begin
    Font.Size := Size;
    Font.Name := Face;
    Font.Color := (Color + 1) mod clWhite;
    TextOut(h, h, Text);
  end;
  r := RotateBitmap(b, Angle);
  FreeBitmap(b);

  GetBitmapSize(r, w, h);
  b := (Color + 1) mod clWhite;
  for y := 0 to h - 1 do
  begin
    for x := 0 to w - 1 do
    begin
      if (FastGetPixel(r, x, y) <> b) then Continue;
      ty := ty - y;
      Break;
    end;
    if (x < w) then
      Break;
  end;
  
  for x := 0 to w - 1 do
  begin
    for y := 0 to h - 1 do
    begin
      if (FastGetPixel(r, x, y) <> b) then Continue;
      tx := tx - x;
      Break;
    end;
    if (y < h) then
      Break;
  end;
    
  if (x < w) then
    for x := x to w - 1 do
      for y := 0 to h - 1 do
      begin
        if (FastGetPixel(r, x, y) <> b) then Continue;
        try
          ColorToRGB(FastGetPixel(Bitmap, x + tx, y + ty), r2, g2, b2);
          FastSetPixel(Bitmap, x + tx, y + ty, RGBtoColor(
            Round(r1 * (1.0 - Alpha) + r2 * Alpha),
            Round(g1 * (1.0 - Alpha) + g2 * Alpha),
            Round(b1 * (1.0 - Alpha) + b2 * Alpha)));
        except end;
      end;
  FreeBitmap(r);
end;

procedure Text_Alpha(Bitmap, Color, tx, ty: Integer; Alpha: Single; Size: Integer; Face, Text: string);
var
  w, h, x, y,
  r1, g1, b1,
  r2, g2, b2: Integer;
  b, c: Integer;
begin
  ColorToRGB(Color, r1, g1, b1);

  b := BitmapFromString(Round(Size * Length(Text) * 1.5), Size * 3, '');
  with GetBitmapCanvas(b) do
  begin
    Font.Size := Size;
    Font.Name := Face;
    w := TextWidth(Text);
    h := TextHeight(Text);
  end;
  FreeBitmap(b);

  b := BitmapFromString(w, h, '');
  c := (Color + 1) mod clWhite;
  with GetBitmapCanvas(b) do
  begin
    Font.Size := Size;
    Font.Name := Face;
    Font.Color := c;
    TextOut(0, 0, Text);
  end;

  for x := x to w - 1 do
    for y := 0 to h - 1 do
    begin
      if (FastGetPixel(b, x, y) <> c) then Continue;
      try
        ColorToRGB(FastGetPixel(Bitmap, x + tx, y + ty), r2, g2, b2);
        FastSetPixel(Bitmap, x + tx, y + ty, RGBtoColor(
          Round(r1 * (1.0 - Alpha) + r2 * Alpha),
          Round(g1 * (1.0 - Alpha) + g2 * Alpha),
          Round(b1 * (1.0 - Alpha) + b2 * Alpha)));
      except end;
    end;
  FreeBitmap(b);
end;

var
  b: Integer;
begin
  ClearDebug;
  b := BitmapFromString(200, 200, '');
  DisplayDebugImgWindow(200, 200);
  
  FastDrawClear(b, clWhite);
  LineTo_Alpha(b, clRed, 50, 10, 150, 10, 0.8);
  RotatedText_Alpha(b, clRed, 10, 10, 0.3, Radians(90), 11, 'arial black', 'Hello there');
  Text_Alpha(b, clGreen, 70, 70, 0.5, 13, 'arial', 'This is a test');
  RotatedText_Alpha(b, clFuchsia, 50, 50, 0.7, Radians(50), 40, 'times new roman', 'Rotated');
  LineTo_Alpha(b, clBlue, 10, 180, 190, 50, 0.7);
  LineTo_Alpha(b, clBlueViolet, 0, 0, 200, 200, 0.7);
  
  SafeDrawBitmap(b, GetDebugCanvas, 0, 0);
  FreeBitmap(b);
end.

procedure LineTo_Alpha(Bitmap, Color, FromX, FromY, ToX, ToY: Integer; Alpha: Single);
procedure RotatedText_Alpha(Bitmap, Color, tx, ty: Integer; Alpha, Angle: Single; Size: Integer; Face, Text: string);
procedure Text_Alpha(Bitmap, Color, tx, ty: Integer; Alpha: Single; Size: Integer; Face, Text: string);

I think the names speak for itself. If you have any questions, feel free to ask :)

~Nielsie95

Join me, we can rule the world together!

From: n3ss3s
Join me, we can rule the world together!

I'll never join you! You killed my father!

I am your father!

From: n3ss3s
I am your father!

The Simpsons movie is old.

Google "I am your father", you'll get a cookie if the page you found it on is even.

From: n3ss3s
Google "I am your father", you'll get a cookie if the page you found it on is even.

en.wikipedia.org/wiki/The_Simpsons_Movie

Star Wars Episode V pl0x

Back to Earth, please.

No, we need to defend the galaxy against the dark side of the force!

Good job anyways :) But it's slow :(

I like the text function!

Shouldn't be too hard to convert to a whole bitmap, either..

It started out with 2 bitmaps actually ;)

program New;

var
  bmp1, bmp2, bmp3: Integer;
  x, y, a: Integer;
  Alpha: Extended;
  r1, r2, g1, g2, b1, b2: Integer;
begin
  bmp1 := LoadBitmap('BITMAP1');
  bmp2 := LoadBitmap('BITMAP2');
  bmp3 := BitmapFromString(100, 100, '');
  DisplayDebugImgWindow(100, 100);
  SafeDrawBitmap(bmp1, GetDebugCanvas, 0, 0);
  for a := 50 downto 0 do
  begin
    Alpha := (a / 50.0);
    for y := 0 to 100 - 1 do
      for x := 0 to 100 - 1 do
      begin
        ColorToRGB(FastGetPixel(bmp1, x, y), r2, g2, b2);
        ColorToRGB(FastGetPixel(bmp2, x, y), r1, g1, b1);
        FastSetPixel(bmp3, x, y, RGBtoColor(
          Round(r1 *(1.0 - Alpha) + r2 * Alpha),
          Round(g1 *(1.0 - Alpha) + g2 * Alpha),
          Round(b1 *(1.0 - Alpha) + b2 * Alpha)));
      end;
    SafeDrawBitmap(bmp3, GetDebugCanvas, 0, 0);
  end;
  FreeBitmap(bmp1);
  FreeBitmap(bmp2);
  FreeBitmap(bmp3);
end.

Make sure you change the paths in LoadBitmap.

smartzkidz you are such a good scripted. I remember last you had a script that wrote your name in paint, now you have a grapher!

Also nice job nielsie95!