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:

{ Erzeugt eine 4Bit-Palette mit den in Colors angegeben Farben
  Wenn Colors weniger als 16 Farben enthält, werden die restlichen Farben
  auf schwarz gesetzt }
procedure CreatePalette4Bit(Bitmap: TBitmap; Colors: array of TColor);
var
  I: Integer;
  Palette: HPalette;
  LogPalette: PLogPalette;
begin
  // Bitmap auf 4Bit setzen
  Bitmap.PixelFormat := pf4Bit;

  // Speicher für Palette reservieren
  GetMem(LogPalette, SizeOf(TLogPalette) + 15 * (SizeOf(TPaletteEntry)));

  // Einstellungen setzen
  LogPalette^.palVersion := $300; 
  LogPalette^.palNumEntries := 16;

  // Alle Paletteneinträge auf 0 (schwarz) setzen
  ZeroMemory(@LogPalette^.palPalEntry[0], 16 * SizeOf(TPaletteEntry));

  // Farben setzen
  for I := 0 To High(Colors) do
  begin
    Colors[I] := ColorToRgb(Colors[I]);
    LogPalette^.palPalEntry[I].peRed   := Colors[I] and $FF;
    LogPalette^.palPalEntry[I].peGreen := Colors[I] and $FF00 shr 8;
    LogPalette^.palPalEntry[I].peBlue  := Colors[I] and $FF0000 shr 16;
    LogPalette^.palPalEntry[I].peFlags := 0;
  end;

  // Palette erzeugen
  Palette := CreatePalette(LogPalette^);

  // Bei Erfolg Palette zuweisen
  if (Palette <> 0) then
    Bitmap.Palette := Palette;

  // Speicher freigeben
  FreeMem(LogPalette);
end;