Sources
Delphi Russian Knowledge Base
DRKB - это самая большая и удобная в использовании база знаний по Дельфи в рунете, составленная Виталием Невзоровым

Как создать disabled битмап из обычного (emboss)?

01.01.2007

CreateMappedBitmap() :-)

Один из паpаметpов yказатель на COLORMAP, в нем для 16 основных цветов делаешь

пеpекодиpовкy, цвета подбеpешь сам из пpинципа:

  все самые яpкие -> в GetSysColor( COLOR_3DLIGHT );

  самые  темные -> GetSysColor( COLOR_3DSHADOW );

  нейтpальные, котpые бyдyт пpозpачные -> GetSysColor( COLOR_3DFACE );

Serge Zakharchuk

(2:5060/32)


procedure Tform1.aaa(bmpFrom,bmpTo:Tbitmap); 
var
 
TmpImage,Monobmp:TBitmap;
 
IRect:TRect;
begin
 
MonoBmp := TBitmap.Create;
 
TmpImage:=Tbitmap.Create;
 
TmpImage.Width := bmpFrom.Width;
 
TmpImage.Height := bmpFrom.Height;
 
IRect := Rect(0, 0, bmpFrom.Width, bmpFrom.Height);
 
TmpImage.Canvas.Brush.Color := clBtnFace;
 
try
   
with MonoBmp do
   
begin
     
Assign(bmpFrom);
     
Canvas.Brush.Color := clBlack;
     
if Monochrome then
 
     
begin
       
Canvas.Font.Color := clWhite;
       
Monochrome := False;
       
Canvas.Brush.Color := clWhite;
     
end;
     
Monochrome := True;
   
end;
   
with TmpImage.Canvas do
   
begin
     
Brush.Color := clBtnFace;
     
FillRect(IRect);
     
Brush.Color := clBlack;
     
Font.Color := clWhite;
     
CopyMode := MergePaint;
     
Draw(IRect.Left + 1, IRect.Top + 1, MonoBmp);
     
CopyMode := SrcAnd;
     
Draw(IRect.Left, IRect.Top, MonoBmp);
 
     
Brush.Color := clBtnShadow;
     
Font.Color := clBlack;
     
CopyMode := SrcPaint;
     
Draw(IRect.Left, IRect.Top, MonoBmp);
     
CopyMode := SrcCopy;
      bmpTo
.assign(TmpImage);
     
TmpImage.free;
   
end;
 
finally
   
MonoBmp.Free;
 
end;
end;
 
procedure TForm1
.Button1Click(Sender: TObject);
begin
  aaa
(image1.picture.bitmap,image2.picture.bitmap);
  Image2
.invalidate;
end;

Писал это не я. Это написал сам Борланд (некузявно было бы взглянуть на класс TButtonGlyph.  Как раз из него я это и выдернул).

Hу а если уже совсем хорошо разобраться, то можно заметить  функцию

ImageList_DrawEx, в которой можно на 25 и 50 процентов уменьшить яркость

(но визуально это очень плохо воспринимается). Соответственно

параметры ILD_BLEND25, ILD_BLEND50, ILD_BLEND-A-MED. Естественно, что

последний абзац работает только с тройкой.

Denis Tanayeff

denis@demo.ru


Это кусочек из рабочей проги на Си, Вроде все лишнее я убрал.

#define CO_GRAY         0x00C0C0C0L 
 
hMemDC      
=       CreateCompatibleDC(hDC);
hOldBitmap  
=   SelectObject(hMemDC, hBits);
 
   
//  hBits это собственно картинка, которую надо "засерить"
 
GetObject(hBits, sizeof(Bitmap), (LPSTR) &Bitmap);
 
if ( GetState(BS_DISABLED) ) // Blt disabled
{
    hOldBrush
= SelectObject(hDC, CreateSolidBrush(CO_GRAY));//CO_GRAY
 
   
PatBlt(hDC, BD_BORDERWIDTH, BD_BORDERWIDTH, Bitmap.bmWidth,
           
Bitmap.bmHeight, PATCOPY);
 
   
DeleteObject(SelectObject(hDC, hOldBrush));
 
    lbLogBrush
.lbStyle = BS_PATTERN;
    lbLogBrush
.lbHatch =(int)LoadBitmap(hInsts,
MAKEINTRESOURCE
(BT_DISABLEBITS));
    hOldBrush
= SelectObject(hDC, CreateBrushIndirect(&lbLogBrush));
 
   
BitBlt(hDC, BD_BORDERWIDTH, BD_BORDERWIDTH, Bitmap.bmWidth,
               
Bitmap.bmHeight, hMemDC, 0, 0, 0x00A803A9UL); // DPSoa
 
   
DeleteObject(SelectObject(hDC, hOldBrush));
   
DeleteObject((HGDIOBJ)lbLogBrush.lbHatch);
 
}

Andy Nikishin

https://www.gs.ru/~links/andy.shtml

(2:5031/16.2)


procedure Emboss(ABitmap : TBitmap; AMount : Integer);
 
var
   x
, y, i : integer;
   p1
, p2: PByteArray;
 
begin
   
for i := 0 to AMount do
   
begin
     
for y := 0 to ABitmap.Height-2 do
     
begin
       p1
:= ABitmap.ScanLine[y];
       p2
:= ABitmap.ScanLine[y+1];
       
for x := 0 to ABitmap.Width do
       
begin
         p1
[x*3] := (p1[x*3]+(p2[(x+3)*3] xor $FF)) shr 1;
         p1
[x*3+1] := (p1[x*3+1]+(p2[(x+3)*3+1] xor $FF)) shr 1;
         p1
[x*3+2] := (p1[x*3+1]+(p2[(x+3)*3+1] xor $FF)) shr 1;
       
end;
     
end;
   
end;
 
end;

Взято с сайта: https://www.swissdelphicenter.ch