This works reasonablty well except I do not think the last 3 columns on the right and bottom side of the image are rendered...
procedure TFormMain.Dither1Click ( Sender: TObject );
// Dither the AlphaColor to a TColor by removing the alphachannel from a 32-bit image then render the outside area as transparent then change the color on the first 3 columns that have alpha = 255 to match the old alpha shade
var
iRGB: TRGB;
w: integer;
h: integer;
iMS: TMemoryStream;
iColor: TColor;
iAlpha: integer;
PointInsideImage: boolean;
Column: integer;
begin
if Assigned ( AdvOfficePager1.ActivePage ) then
begin
FImageENView := TImageEnView ( AdvOfficePager1.ActivePage.Controls [ 0 ] );
if Assigned ( FImageENView ) then
begin
FImageENView.Proc.SaveUndoCaptioned ( 'Dither Alpha ' + IntToStr ( FImageENView.Proc.UndoCount ) );
Undo1.Hint := 'Dither Alpha ' + IntToStr ( FImageENView.Proc.UndoCount + 1 );
FImageENView.Proc.ClearAllRedo;
// convert to 24 bit
if FImageENView.HasAlphaChannel then
FImageENView.RemoveAlphaChannel;
// make the pixels outside of the bitmap transparent
FImageENView.IO.Params.BitsPerSample := 8;
FImageENView.IO.Params.SamplesPerPixel := 4;
FImageENView.IO.Params.ICO_BitCount [ AdvOfficePager1.ActivePageIndex ] := 32;
iRGB := FImageENView.IEBitmap.Pixels [ 0, FImageENView.IEBitmap.Height - 1 ];
FImageENView.Proc.SetTransparentColors ( iRGB, iRGB, 0 );
// dither the alpha channel on first 3 columns with alpha = 255
for w := 0 to FImageENView.Bitmap.Width - 1 do
begin
for h := 0 to FImageENView.Bitmap.Height - 1 do
begin
Column := 0;
// if alpha = 255 then point inside the image
if FImageENView.IEBitmap.Alpha [ w, h ] = 255 then
begin
PointInsideImage := True;
inc ( Column );
end
else
begin
PointInsideImage := False;
Column := 0;
end;
if Column > 3 then
Column := 0;
// Only convert the colors for the first three columns
if ( PointInsideImage ) and ( Column = 1 ) then
begin
//if 1st column then (outermost column)
iColor := FImageENView.IEBitmap.Canvas.Pixels [ w, h ];
iRGB := TColor2TRGB ( iColor );
iAlpha := FImageENView.IEBitmap.Alpha [ w, h ];
iRGB.r := Trunc ( iAlpha / 255 * iRGB.r ) + ( 255 - iAlpha );
iRGB.g := Trunc ( iAlpha / 255 * iRGB.g ) + ( 255 - iAlpha );
iRGB.b := Trunc ( iAlpha / 255 * iRGB.b ) + ( 255 - iAlpha );
iColor := TRGB2TColor ( iRGB );
FImageENView.IEBitmap.Canvas.Pixels [ w, h ] := iColor;
end;
if ( PointInsideImage ) and ( Column = 2 ) then
begin
//if 2nd column then (next column)
iColor := FImageENView.IEBitmap.Canvas.Pixels [ w, h ];
iRGB := TColor2TRGB ( iColor );
iAlpha := FImageENView.IEBitmap.Alpha [ w, h ];
iRGB.r := Trunc ( iAlpha / 255 * iRGB.r ) + ( 255 - iAlpha );
iRGB.g := Trunc ( iAlpha / 255 * iRGB.g ) + ( 255 - iAlpha );
iRGB.b := Trunc ( iAlpha / 255 * iRGB.b ) + ( 255 - iAlpha );
iColor := TRGB2TColor ( iRGB );
FImageENView.IEBitmap.Canvas.Pixels [ w, h ] := iColor;
end;
if ( PointInsideImage ) and ( Column = 3 ) then
begin
//if 3rd column then (next column)
iColor := FImageENView.IEBitmap.Canvas.Pixels [ w, h ];
iRGB := TColor2TRGB ( iColor );
iAlpha := FImageENView.IEBitmap.Alpha [ w, h ];
iRGB.r := Trunc ( iAlpha / 255 * iRGB.r ) + ( 255 - iAlpha );
iRGB.g := Trunc ( iAlpha / 255 * iRGB.g ) + ( 255 - iAlpha );
iRGB.b := Trunc ( iAlpha / 255 * iRGB.b ) + ( 255 - iAlpha );
iColor := TRGB2TColor ( iRGB );
FImageENView.IEBitmap.Canvas.Pixels [ w, h ] := iColor;
end;
end;
end;
end;
FImageENView.Update;
// update the preview
iMS := TMemoryStream.Create;
try
FImageENView.LayersSaveToStream ( iMS );
iMS.Position := 0;
ImageEnView1.LayersLoadFromStream ( iMS );
finally
iMS.Free;
end;
FImageENView.Bitmap.Modified := True;
ImageEnView1.Update;
end;
end;
William Miller