procedure TfrmMain.MakePalette(forBitMap: TBitMap); var pNewPal : PLogPalette;lSize : LongInt;nCntr : Byte;begin lSize := SizeOf(TLogPalette) +SizeOf(TPaletteEntry) * 256;tryGetMem(pNewPal, lSize);pNewPal^.palNumEntries := 256;pNewPal^.palVersion := $300;{$R-}{выключаем контроль допустимого диапазона}{создаем данные палитры...}for nCntr := 0 to 254 dobeginpNewPal^.palPalEntry[nCntr].peRed := nCntr + 20;pNewPal^.palPalEntry[nCntr].peGreen := nCntr + 20;pNewPal^.palPalEntry[nCntr].peBlue := nCntr + 20;pNewPal^.palPalEntry[nCntr].peFlags := pc_nocollapse;end;{$R+}{включаем контроль допустимого диапазона}{удаляем старый hPal; предохраняемся от утечки памяти}DeleteObject(hPal);{создаем новую палитру на основе новых значений}hPal := CreatePalette(pNewPal^);{назначаем новую палитру}forBitMap.Palette := hPal;finallyFreeMem(pNewPal, lSize);end;end; |
- Bob Teller [000826]