1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:

type
  TPseudoRGB = packed record
    First: Word;
    Last: Byte;
  end;
  PPseudoRGB = ^TPseudoRGB;
var
  Test: TBitmap;
  NewLine, OldLine, LastOldLine, OldWidth: Integer;
  x, x2, OldPixel, NewPixel1, NewPixel2, NewPixel3: PPseudoRGB;
begin
  Test := TBitmap.Create;
  try
    Test.LoadFromFile(...);
    Test.PixelFormat := pf24bit;
    LastOldLine := Test.Height - 1;
    OldWidth := Test.Width - 1;
    Test.SetSize(Test.Width * 3, Test.Height * 3);
    for OldLine := LastOldLine downto 0 do
    begin
      OldPixel := Test.ScanLine[OldLine];
      NewLine := OldLine * 3;
      NewPixel1 := Test.ScanLine[NewLine];
      NewPixel2 := Test.ScanLine[NewLine + 1];
      NewPixel3 := Test.ScanLine[NewLine + 2];
      for x := 1 to OldWidth do
      begin
        for x2 := 1 to 3 do
        begin
          NewPixel1.First := OldPixel.First;
          NewPixel1.Last := OldPixel.Last;
          Inc(NewPixel1);
          NewPixel2.First := OldPixel.First;
          NewPixel2.Last := OldPixel.Last;
          Inc(NewPixel2);
          NewPixel3.First := OldPixel.First;
          NewPixel3.Last := OldPixel.Last;
          Inc(NewPixel3);
        end;
        Inc(OldPixel);
      end;
    end;
    Test.SaveToFile(...);
  finally
    Test.Free;
  end;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:

procedure SkaliereBMP(ABitmap: TBitmap; AFaktorX, AFaktorY: Integer);
type
  TBGR = packed record
    B: Byte;
    G: Byte;
    R: Byte;
  end;
  PBGR = ^TBGR;
var
  OldWidth, OldHeight, NewWidth, NewHeight, x1, x2, y1, y2: Integer;
  OldPixel, NewPixel: PBGR;
begin
  ABitmap.Pixelformat := pf24Bit;
  OldWidth  := ABitmap.Width;
  OldHeight := ABitmap.Height;
  NewWidth  := OldWidth  * AFaktorX;
  NewHeight := OldHeight * AFaktorY;
  {horizontal Skalieren}
  if AFaktorX > 1 then
  begin
    ABitmap.SetSize(NewWidth, OldHeight);
    for y1 := 0 to OldHeight - 1 do
    begin
      OldPixel := ABitmap.ScanLine[y1];
      NewPixel := OldPixel;
      Inc(OldPixel, OldWidth);
      Inc(NewPixel, NewWidth);
      for x1 := OldWidth - 1 downto 0 do
      begin
        Dec(OldPixel);
        for x2 := AFaktorX - 1 downto 0 do
        begin
          Dec(NewPixel);
          NewPixel^ := OldPixel^;
        end;
      end;
    end;
  end;
  {vertikal Skalieren}
  if AFaktorY > 1 then
  begin
    ABitmap.SetSize(NewWidth, NewHeight);
    for y1 := OldHeight - 1 downto 0 do
    begin
      OldPixel := ABitmap.ScanLine[y1];
      for y2 := AFaktorY - 1 downto 0 do
      begin
        NewPixel := ABitmap.ScanLine[y1 * AFaktorY + y2];
        Move(OldPixel^, NewPixel^, SizeOf(TBGR) * NewWidth);
      end;
    end;
  end;
end;