// Der folgende Code zeigt mehrere Möglichkeiten zum Auslesen eines
// Bitmaps
(und einer Bitmap-Palette) aus einer Ressource. Für die
// Beispiele wurde folgender Ressource-Quelltext verwendet:

//
bmp  BITMAP  d:\bilder\frau.bmp
//
raw  RCDATA  d:\bilder\frau.bmp

// Die zweite Zeile zeigt, dass man Bitmaps auch als Raw-Data in
// die Ressource einbinden kann. Siehe dazu den Code unter 4.
// Bei allen Beispielen wird das Bild zweimal nebeneinander auf
// die Form gezeichnet. Zweimal deshalb, um zu zeigen, dass man
// bei einigen Varianten das Bild ein zweites Mal holen muss,
// um es erneut zu zeichnen.

// Getestet mit D4 unter XP

{$R test.res} 
 
//-------------------------------------------------- 
// 1. Mittels TBitmap und LoadBitmap
 
procedure TForm1.Button1Click(Sender: TObject); 
var 
  bm: TBitmap; 
begin 
  bm := TBitmap.create; 
  bm.handle := LoadBitmap(HInstance, 'bmp'); 
  canvas.draw(0, 0, bm); 
  canvas.draw(bm.width, 0, bm); 
  bm.free; 
end; 
 
//-------------------------------------------------- 
// 2. Mittels HBitmap und LoadBitmap
 
var 
  w: integer; 
 
procedure DrawResHBmp(Instance: THandle; dc: HDC; 
  x, y: Integer; ResNam: Pchar); 
var 
  hb, hmb: HBitmap; 
  tbm: tagBITMAP; 
  hMemDC: HDC; 
begin 
  hb := LoadBitmap(Instance, ResNam); 
  GetObject(hb, sizeof(tbm), @tbm); 
  w := tbm.bmWidth; 
  hMemDC := CreateCompatibleDC(dc); 
  hmb := SelectObject(hMemDC, hb); 
  BitBlt(dc, x, y, tbm.bmWidth, tbm.bmHeight, hMemDC, 0, 0, SRCCOPY); 
  DeleteObject(SelectObject(hMemDC, hmb)); 
  DeleteDC(hMemDC); 
end; 
 
procedure TForm1.Button2Click(Sender: TObject); 
begin 
  DrawResHBmp(HInstance, canvas.handle, 0, 0, 'bmp'); 
  DrawResHBmp(HInstance, canvas.handle, w, 0, 'bmp'); 
end; 
 
//-------------------------------------------------- 
// 3. Mittels TBitmap und LoadFromResourceName
 
procedure TForm1.Button3Click(Sender: TObject); 
var 
  bm: TBitmap; 
begin 
  bm := TBitmap.create; 
  bm.LoadFromResourceName(HInstance, 'bmp'); 
  canvas.draw(0, 0, bm); 
  canvas.draw(bm.width, 0, bm); 
  bm.free; 
end; 
 
//-------------------------------------------------- 
// 4. Mittels TBitmap und TResourceStream
 
procedure TForm1.Button4Click(Sender: TObject); 
var 
  bm: TBitmap; 
  trs: TCustomMemoryStream; 
begin 
  bm := TBitmap.create; 
  trs := TResourceStream.create(HInstance, 'raw', RT_RCDATA); 
  bm.LoadFromStream(trs); 
  canvas.draw(0, 0, bm); 
  canvas.draw(bm.width, 0, bm); 
  bm.free; 
end; 
 
//-------------------------------------------------- 
// 5. Mittels HBitmap und LoadBitmap
 
{$R-} 
 
var 
  hPal: HPalette; 
  b: integer; 
 
function CreateDIBPalette(PBI: PBITMAPINFO): HPALETTE; 
var 
  lPal: ^LogPalette; 
  NumColors, i: integer; 
  bbc: word; 
begin 
  bbc := PBI.bmiHeader.biBitCount; 
  if bbc <= 8 then begin 
    NumColors := 1 shl bbc; 
    GetMem(lPal, sizeof(LogPalette) + sizeof(PaletteEntry) * NumColors); 
    lPal.palVersion := $300; 
    lPal.palNumEntries := NumColors; 
    for i := 0 to NumColors - 1 do 
    begin 
      lPal.palPalEntry[i].peRed := PBI.bmiColors[i].rgbRed; 
      lPal.palPalEntry[i].peGreen := PBI.bmiColors[i].rgbGreen; 
      lPal.palPalEntry[i].peBlue := PBI.bmiColors[i].rgbBlue; 
      lPal.palPalEntry[i].peFlags := 0; 
    end; 
    result := CreatePalette(lPal^); 
    FreeMem(lPal); 
  end else result := 0; 
end; 
 
function GetDIBPalette(hInstance: Longint; RscNam: PChar): HPALETTE; 
var 
  hRsrc, hGlobal: THandle; 
  PBI: PBITMAPINFO; 
begin 
  hRsrc := FindResource(hInstance, RscNam, RT_BITMAP); 
  if hRsrc > 0 then begin 
    hGlobal := LoadResource(hInstance, hRsrc); 
    PBI := LockResource(hGlobal); 
    result := CreateDIBPalette(PBI); 
    UnlockResource(hGlobal); 
    FreeResource(hGlobal); 
  end else result := 0; 
end; 
 
procedure DrawResPalBmp(Instance: THandle; dc: HDC; 
  x, y: Integer; ResNam: Pchar); 
var 
  hb, hmb: HBitmap; 
  tbm: tagBITMAP; 
  hMemDC: HDC; 
begin 
  hb := LoadBitmap(Instance, ResNam); 
  GetObject(hb, sizeof(tbm), @tbm); 
  b := tbm.bmWidth; 
  hMemDC := CreateCompatibleDC(dc); 
  SelectPalette(dc, hPal, false); 
  RealizePalette(dc); 
  SelectPalette(hMemDC, hPal, false); 
  RealizePalette(hMemDC); 
  hmb := SelectObject(hMemDC, hb); 
  BitBlt(dc, x, y, tbm.bmWidth, tbm.bmHeight, hMemDC, 0, 0, SRCCOPY); 
  DeleteObject(SelectObject(hMemDC, hmb)); 
  DeleteDC(hMemDC); 
end; 
 
procedure TForm1.Button5Click(Sender: TObject); 
var 
  ResNam: PChar; 
begin 
  ResNam := 'bmp'; 
  hPal := GetDIBPalette(HInstance, ResNam); 
  DrawResPalBmp(HInstance, canvas.handle, 0, 0, ResNam); 
  DrawResPalBmp(HInstance, canvas.handle, b, 0, ResNam); 
  DeleteObject(hPal); 
end; 



Zugriffe seit 6.9.2001 auf Delphi-Ecke