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

Материал из DRKB


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);


Author: Serge Zakharchuk (2:5060/32)
ID: 03883



Создание Disabled значка для кнопки[править | править код]

procedure TForm1.Emboss(bmpFrom, bmpTo: TBitmap);
var
  TmpImage, MonoBmp: TBitmap;
  ImgRect: TRect;
begin
  MonoBmp := TBitmap.Create;
  TmpImage := TBitmap.Create;
  TmpImage.Width := bmpFrom.Width;
  TmpImage.Height := bmpFrom.Height;
  ImgRect := 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(ImgRect);
      Brush.Color := clBlack;
      Font.Color := clWhite;
      CopyMode := MergePaint;
      Draw(ImgRect.Left + 1, ImgRect.Top + 1, MonoBmp);
      CopyMode := SrcAnd;
      Draw(ImgRect.Left, ImgRect.Top, MonoBmp);

      Brush.Color := clBtnShadow;
      Font.Color := clBlack;
      CopyMode := SrcPaint;
      Draw(ImgRect.Left, ImgRect.Top, MonoBmp);
      CopyMode := SrcCopy;
      bmpTo.Assign(TmpImage);
    end;
  finally
    TmpImage.Free;
    MonoBmp.Free;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Emboss(Image1.Picture.Bitmap, Image2.Picture.Bitmap);
  Image2.Invalidate;
end;


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

Hу а если уже совсем хорошо разобраться, то можно заметить функцию ImageList_DrawEx, в которой можно на 25 и 50 процентов уменьшить яркость (но визуально это очень плохо воспринимается). Соответственно параметры ILD_BLEND25, ILD_BLEND50, ILD_BLEND-A-MED. Естественно, что последний абзац работает только с тройкой.


Author: Denis Tanayeff (denis@demo.ru)
ID: 03884



Пример на С++[править | править код]

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


#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);
}


Author: Andy Nikishin (2:5031/16.2)
Source: http://www.gs.ru/~links/andy.shtml
ID: 03885



Фильтр Emboss на заданную величину[править | править код]

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;


Source: http://www.swissdelphicenter.ch
ID: 03886