Ændre farve på ikon

unit Unit1;

interface

uses
  Windows, Classes, Graphics, Controls, Forms;

type
  TForm1 = class(TForm)
    procedure FormPaint(Sender: TObject);
  private
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

const
COLOR_TRNSP = clFuchsia;

function icoToBmp(aIco:tIcon;aBmp:tBitmap;const aBgColor:tColor=COLOR_TRNSP):boolean;
begin
with aBmp,canvas do begin
  pixelFormat:=pf24bit;height:=aIco.height;width:=aIco.width;
  pen.color:=aBgColor;brush.color:=aBgColor;
  result:=(width>0) and (height>0);
  if result then try
  rectangle(0,0,width,height);
  draw(0,0,aIco)
  except result:=false end
end;
end;

procedure splitRgb(const aColor:tColor;out r,g,b:byte);  //udtræk RGB værdierne
begin r:=byte(aColor);g:=byte(aColor shr 8);b:=byte(aColor shr 16) end;

type
pRgb=^tRgb;
tRgb=packed record b,g,r:byte end; //**

function pIsColor(p:pRgb;const aR,aG,aB:byte):boolean;  //sammenlign med "pRgb"
begin with p^ do result:=(r=aR) and (g=aG) and (b=aB) end;

procedure pSetColor(p:pRgb;const aR,aG,aB:byte);  //definer "pRgb"
begin with p^ do begin r:=aR;g:=aG;b:=aB end end;

function replaceColor(aBmp:tBitmap;const aFrom,aTo:tColor):boolean;  //24 bit only
var p:pRgb;x,y:integer;fR,fG,fB,tR,tG,tB:byte;
begin result:=false;if aFrom=aTo then exit;
with aBmp do if (width>0) and (height>0) then try
  splitRgb(aFrom,fR,fG,fB);splitRgb(aTo,tR,tG,tB);

  for y:=0 to height-1 do begin p:=scanLine[y];
  for x:=0 to width-1 do begin
    if pIsColor(p,fR,fG,fB) then pSetColor(p,tR,tG,tB);
    inc(p)
  end
  end

except result:=false end
end;

//--

procedure TForm1.FormPaint(Sender: TObject);
var aBmp:tBitmap;aIco:tIcon;
begin
aIco:=tIcon.create;
aIco.assign(application.icon);
aBmp:=tBitmap.create;
if icoToBmp(aIco,aBmp) then begin
  replaceColor(aBmp,clFuchsia,clRed);    //udskift farve
  replaceColor(aBmp,clYellow,clBlack);    //udskift farve
  self.canvas.draw(0,0,aBmp);
end;

aBmp.free;
aIco.free
end;

end.

unit baseBmp;

interface

uses
windows,classes,controls,graphics,jpeg;

type
str=ansiString;
lInt=longInt;
ptr=pointer;
tJpg=tJpegImage;

type
pRgb=^tRgb;
tRgb=packed record b,g,r:byte end;
//-----------------------------|----------------|----------------------|----------------------------
tBmp=class(tBitmap)//eksempel på en "standard bitmap" som kan nedarves fra
  procedure reset;virtual;
  procedure clearImg(const aColor:tColor);      //Full size rectangle
  function isEmpty:boolean;                    //No data in the image
  function is24bit:boolean;                    //Is it 24bit format
  procedure setColors(aPen,aBrush:tColor);
  procedure setFont(aName:str;aSize:byte;aStyle:tFontStyles;aColor:tColor);
  function replaceColor(const aFrom,aTo:tColor):boolean;  //24bit
private
protected
public
  constructor create(aWidth:lInt=0;aHeight:lInt=0);reintroduce;virtual;
  procedure setSize(const aWidth,aHeight:lInt);overload;
  procedure setSize(const aControl:tControl);overload;
  procedure setSize(const aGraphic:tGraphic);overload;
  function setBy(aBmp:tBitmap):boolean;overload;
  function setBy(aIcon:tIcon):boolean;overload;
  function setBy(aJpg:tJpg):boolean;overload;
  function setBy(il:tImageList;const aImgId:lInt):boolean;overload;
  function exportTo(aBmp:tBmp):boolean;overload;
  function exportTo(aCanvas:tCanvas;x,y:lInt):boolean;overload;
end;
//-----------------------------|----------------|----------------------|----------------------------
tMaskedBmp=class(tBmp)//Eksempel på nedarvet objekt til udskifning af farve
  function exportedMasked(aCanvas:tCanvas;x,y:lInt;aColor:tColor):boolean;//overload;
private
  fMaskBaseColor              :tColor;
protected
public
  constructor create(aWidth:lInt=0;aHeight:lInt=0);override;
  property maskBaseColor      :tColor          read fMaskBaseColor    write fMaskBaseColor;
end;
//-----------------------------|----------------|----------------------|----------------------------

function lcFileExt(const aFileName:str):str;
procedure splitRgb(const aColor:tColor;out r,g,b:byte);
function pIsColor(p:pRgb;const aR,aG,aB:byte):boolean;
procedure pSetColor(p:pRgb;const aR,aG,aB:byte);

implementation

uses
sysUtils;

function lcFileExt(const aFileName:str):str;
begin result:=lowerCase(extractFileExt(aFileName)) end;

procedure splitRgb(const aColor:tColor;out r,g,b:byte);
begin r:=byte(aColor);g:=byte(aColor shr 8);b:=byte(aColor shr 16) end;

function pIsColor(p:pRgb;const aR,aG,aB:byte):boolean;
begin with p^ do result:=(r=aR) and (g=aG) and (b=aB) end;

procedure pSetColor(p:pRgb;const aR,aG,aB:byte);
begin with p^ do begin r:=aR;g:=aG;b:=aB end end;

//--------------------------------------------------------------------------------------------------
//tBmp:

constructor tBmp.create(aWidth:lInt=0;aHeight:lInt=0);//reintroduce;virtual;
begin inherited create;reset;setSize(aWidth,aHeight) end;

procedure tBmp.reset;begin pixelFormat:=pf24bit;setSize(0,0) end;
function tBmp.isEmpty:boolean;begin result:=(height=0) or (width=0) end;
function tBmp.is24bit:boolean;begin result:=pixelFormat=pf24bit end;
procedure tBmp.clearImg(const aColor:tColor);begin setColors(aColor,aColor);canvas.rectangle(0,0,width,height) end;
procedure tBmp.setSize(const aWidth,aHeight:lInt);begin height:=aHeight;width:=aWidth end;
procedure tBmp.setSize(const aControl:tControl);begin with aControl do setSize(width,height) end;
procedure tBmp.setSize(const aGraphic:tGraphic);begin with aGraphic do setSize(width,height) end;

procedure tBmp.setColors(aPen,aBrush:tColor);
begin with canvas do begin pen.color:=aPen;brush.color:=aBrush end end;

procedure tBmp.setFont(aName:str;aSize:byte;aStyle:tFontStyles;aColor:tColor);
begin with canvas.font do begin name:=aName;size:=aSize;style:=aStyle;color:=aColor end end;

function tBmp.setBy(aBmp:tBitmap):boolean;//overload;
begin reset;setSize(aBmp);
try canvas.draw(0,0,aBmp);result:=not isEmpty except result:=false end
end;

function tBmp.setBy(aIcon:tIcon):boolean;//overload;
begin reset;setSize(aIcon);
try canvas.draw(0,0,aIcon);result:=not isEmpty except result:=false end
end;

function tBmp.setBy(aJpg:tJpg):boolean;//overload;
var aBmp:tBmp;
begin reset;
aBmp:=tBmp.create;
try aBmp.assign(aJpg);result:=not aBmp.isEmpty except result:=false end;
result:=result and setBy(aBmp);
freeAndNil(aBmp)
end;

function tBmp.setBy(il:tImageList;const aImgId:lInt):boolean;//overload;
begin reset;setSize(il.width,il.height);
try il.draw(canvas,0,0,aImgId);result:=not isEmpty except result:=false end;
end;

function tBmp.exportTo(aBmp:tBmp):boolean;//overload;
begin result:=aBmp.setBy(self) end;

function tBmp.exportTo(aCanvas:tCanvas;x,y:lInt):boolean;//overload;
begin try aCanvas.draw(x,y,self);result:=not isEmpty except result:=false end end;

//Bemærk denne rutine er nu integreret i basis komponent
function tBmp.replaceColor(const aFrom,aTo:tColor):boolean;  //24bit
var p:pRgb;x,y:integer;fR,fG,fB,tR,tG,tB:byte;
begin result:=false;if aFrom=aTo then exit;
if (width>0) and (height>0) then try
  splitRgb(aFrom,fR,fG,fB);splitRgb(aTo,tR,tG,tB);
  for y:=0 to height-1 do begin p:=scanLine[y];
  for x:=0 to width-1 do begin
    if pIsColor(p,fR,fG,fB) then pSetColor(p,tR,tG,tB);
    inc(p)
  end
  end
except result:=false end
end;

//--------------------------------------------------------------------------------------------------
//tMaskedBmp:

constructor tMaskedBmp.create(aWidth:lInt=0;aHeight:lInt=0);//override;
begin inherited create(aWidth,aHeight);
transparentColor:=clFuchsia;
fMaskBaseColor:=clYellow;
end;

//Eksporterer en bitmap med ønsket farve
function tMaskedBmp.exportedMasked(aCanvas:tCanvas;x,y:lInt;aColor:tColor):boolean;//overload;
var aBmp:tBmp;
begin result:=not isEmpty;if not result then exit;
with tBmp.create(width,height) do begin
  clearImg(self.transparentColor);canvas.draw(0,0,self);
  replaceColor(self.fMaskBaseColor,aColor);
  result:=exportTo(aCanvas,x,y);
  free
end
end;

end.

unit Unit1;

interface

uses
  Windows, SysUtils, Classes, Graphics, Controls, Forms, baseBmp;

type
  TForm1 = class(TForm)
    procedure FormPaint(Sender: TObject);
  private
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormPaint(Sender: TObject);
var aBmp:tMaskedBmp;aIco:tIcon;
begin
aIco:=tIcon.create;aIco.assign(application.icon);
aBmp:=tMaskedBmp.create;aBmp.setBy(aIco);
freeAndNil(aIco);
  canvas.Draw(32,32,aBmp);
aBmp.transparentColor:=clFuchsia;  //Baggrundsfarve som evt senere skal være transparent
aBmp.maskBaseColor:=clYellow;      //Farve i basis-ikon som skal udskiftes

aBmp.exportedMasked(canvas,0,0,clWhite);
aBmp.exportedMasked(canvas,32,0,clBlack);
aBmp.exportedMasked(canvas,64,0,clRed);
aBmp.exportedMasked(canvas,96,0,clGreen);
aBmp.exportedMasked(canvas,128,0,clBlue);

freeAndNil(aBmp)
end;

end.