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

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

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

#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