// 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;
|