Mega Code Archive
Coloursubstitution
<![CDATA[
unit Unit1;
//Richard Ebbs for EMISLEGAL 16.02.01
//tiny program to test the setting of a colour to be TRANSPARENT
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls;
type
TMainForm = class(TForm)
Image: TImage;
ExitButton: TButton;
procedure FormCreate(Sender: TObject);
procedure ExitButtonClick(Sender: TObject);
procedure SubstituteBitMapColours(var aBitMap: Graphics.TBitMap;
oldColour, newColour: TColor);
procedure FillBMPBackGround(var aBitMap: Graphics.TBitMap; fillCol: TColor);
private
//private declarations
public
//public declarations
end;
var
MainForm: TMainForm;
implementation
{$R *.DFM}
procedure TMainForm.ExitButtonClick(Sender: TObject);
begin
Close;
end;
////////////////////////////////////////////
procedure TMainForm.FormCreate(Sender: TObject);
//so far all attempts at setting one of the
//colours in a bitmap image to be transparent
//have failed; so instead we use the DIY
//SubstituteBitMapColours function. UPDATE:
//various (most) of the commented-out chunks
//of code DO work WHEN THE ORIGINAL IMAGE IS
//SAVED a) AS A 256-COLOUR (8-bit) IMAGE, AND
//b) WHEN THE IMAGE IS SAVED (in PhotoShop or
//other reasonable graphics package) SUCH THAT
//IT IS DEFINED AS USING THE WINDOWS SYTEM
//PALETTE...
var
tempBitMap: Graphics.TBitMap;
colourToReplace: TColor;
newColour: TColor;
begin
tempBitMap := Graphics.TBitMap.Create;
tempBitMap.LoadFromFile('Doc128.bmp');
//tempBitMap.Transparent := True;
//tempBitMap.Transparent := False;
//tempBitMap.TransParentColor := clWhite;
//tempBitMap.TransParentColor := tempBitMap.Canvas.Pixels[1,1];
//colourToReplace := tempBitMap.Canvas.Pixels[1, 1];
//tempBitMap.TransparentMode := tmFixed;
//tempBitMap.TransparentMode := tmAuto;
//SetBkMode(tempBitMap.Canvas.Handle, TRANSPARENT);
//SubstituteBitMapColours(tempBitMap, colourToReplace, clBlue);
newColour := MainForm.Color;
SubstituteBitMapColours(tempBitMap, clFuchsia, newColour);
//FillBMPBackGround(tempBitMap, clBlue);
{with tempBitmap do
begin
Transparent := True;
TransparentColor := clWhite;
//TransparentColor := Canvas.Pixels[1, 1];
end;}
Image.Canvas.Draw(0, 0, tempBitMap);
//Image.Picture.Graphic.Transparent := True;
{with Image.Picture.Bitmap do
begin
Transparent := True;
//TransparentColor := clWhite;
TransparentColor := Canvas.Pixels[1, 1];
Refresh;
end;}
tempBitMap.Free;
end;
/////////////////////////////////////////////////////////////////////////
procedure TMainForm.SubstituteBitMapColours(var aBitMap: Graphics.TBitMap;
oldColour, newColour: TColor);
//code above (in the FormCreate method) for setting one colour within a
//bitmap to be transparent, does not work (as it should, since the code
//is from a Borland example). So we have to do things longhand, and
//substitute every instance of a colour within a bitmap to be some new
//(pssed in) colour. The way we do it is slow: using scanline somehow
//would probably be faster (so edit this is if speed is a problem)...
//THIS WORKS INTERMITTENTLY, but NOT all of the time...
var
wIdx: Integer;
hIdx: Integer;
begin
//this is a SLOW WAY OF DOING IT...
for wIdx := 0 to aBitMap.Width do
begin
for hIdx := 0 to aBitMap.Height do
begin
if (aBitMap.Canvas.Pixels[widx, hIdx] = oldColour) then
begin
aBitMap.Canvas.Pixels[widx, hIdx] := newColour;
end;
end;
end;
end;
////////////////////////////////////////////////////////////////////////////////////
procedure TMainForm.FillBMPBackGround(var aBitMap: Graphics.TBitMap; fillCol: TColor);
var
oldBrCol: TColor;
currBkColour: TColor;
begin
oldBrCol := aBitMap.Canvas.Brush.Color;
aBitMap.Canvas.Brush.Color := fillCol;
//using the pixel at 1, 1 as a basis for floodfilling should
//work with ANY bitmap we care to use (if we set it up right)
currBkColour := aBitMap.Canvas.Pixels[1, 1];
aBitMap.Canvas.FloodFill(1, 1, currBkColour, fsSurface);
//aBitMap.Canvas.FloodFill(1, 1, fillCol, fsSurface);
aBitMap.Canvas.Brush.Color := oldBrCol;
end;
end.
]]>