Главная страница | Продукты | Delphi | Юмор | Контакт

Графика и Delphi

Копирование TIcon в TBitmap
Копирование TBitmap в TIcon
Быстрая замена цвета в Tbitmap
Рисование на экране

Копирование TIcon в TBitmap

procedure IconToBitmap(ico:TIcon;Bitmap:Tbitmap);
begin
 Bitmap.Width := Ico.Width;
 Bitmap.Height := Ico.Height;
 Bitmap.Canvas.Draw(0, 0, Ico);
end;

Копирование TBitmap в TIcon

procedure BitmapToIcon(Bitmap:Tbitmap;ico:TIcon);
var
 winDC, srcdc, destdc : HDC;
 oldBitmap : HBitmap;
 iinfo : TICONINFO;
begin
 GetIconInfo(Ico.Handle, iinfo);
 WinDC := getDC(0);
 srcDC := CreateCompatibleDC(WinDC);
 destDC := CreateCompatibleDC(WinDC);
 SelectObject(destDC, iinfo.hbmColor);
 oldBitmap := SelectObject(srcDC, iinfo.hbmMask);

 BitBlt(destdc, 0, 0, ico.width,ico.height,
           srcdc, 0, 0, SRCPAINT);
 Bitmap.handle := SelectObject(destDC, oldBitmap);
 DeleteDC(destDC);
 DeleteDC(srcDC);
 ReleaseDC(WinDC,0);
end;
Быстрая замена цвета в Tbitmap
procedure bmpChangeColor(BMP:TBitmap;OldColor,NewColor:TColor);
var
 w,iy,ix,ix3,h,w_1,h_1: Longint;
 TempBmp:TBitmap;
 ips:PlongintArray;
 wps:PWordArray;
 bps:PByteArray;
 c,cfrom,cto:longint;
 wfrom,wto:word;
 b,bfrom,bto,bnt:byte;
 svColor:Tcolor;
 nt:integer;
 isoddix:boolean;
 pint:^longint;
 r:Trect;
begin
 if bmp.empty then exit;
 w:=BMP.Width;
 h:=BMP.Height;
 w_1:=w-1;
 h_1:=h-1;
 svColor:=bmp.canvas.pixels[0,0];
 bmp.canvas.pixels[0,0]:=OldColor;
 case bmp.PixelFormat of
 pf32bit:begin
  ips:=bmp.scanline[0];
  cfrom:=ips^[0] and $00FFFFFF;
  bmp.canvas.pixels[0,0]:=NewColor;
  ips:=bmp.scanline[0];
  cto:=ips^[0] and $00FFFFFF;
  bmp.canvas.pixels[0,0]:=svColor;
  for iy:=0 to h_1 do begin
   ips:=bmp.scanline[iy];
   for ix:=0 to w_1 do begin
    if (ips^[ix] and $00FFFFFF)=cfrom then ips^[ix]:=cto;
   end;
  end;
 end;pf16bit,pf15bit:begin
  wps:=bmp.scanline[0];
  wfrom:=wps^[0];
  bmp.canvas.pixels[0,0]:=NewColor;
  wps:=bmp.scanline[0];
  wto:=wps^[0];
  bmp.canvas.pixels[0,0]:=svColor;
  for iy:=0 to h_1 do begin
   wps:=bmp.scanline[iy];
   for ix:=0 to w_1 do begin
    if wps^[ix]=wfrom then wps^[ix]:=wto;
   end;
  end;
 end;pf8bit:begin
  bps:=bmp.scanline[0];
  bfrom:=bps^[0];
  bmp.canvas.pixels[0,0]:=NewColor;
  bps:=bmp.scanline[0];
  bto:=bps^[0];
  bmp.canvas.pixels[0,0]:=svColor;
  for iy:=0 to h_1 do begin
   bps:=bmp.scanline[iy];
   for ix:=0 to w_1 do begin
    if bps^[ix]=bfrom then bps^[ix]:=bto;
   end;
  end;
 end;pf4bit:begin
  bps:=bmp.scanline[0];
  bfrom:=GetTetrad(bps,0);
  bmp.canvas.pixels[0,0]:=NewColor;
  bps:=bmp.scanline[0];
  bto:=GetTetrad(bps,0);
  bmp.canvas.pixels[0,0]:=svColor;
  for iy:=0 to h_1 do begin
   bps:=bmp.scanline[iy];
   for ix:=0 to w_1 do begin
//gettetrad
    nt:=ix shr 1;
    bnt:=bps[nt];
    isoddix:=odd(ix);
    if isoddix then b:=bnt and $0F
    else b:=bnt shr 4;
    if b=bfrom then begin //settetrad
     if isoddix then bps[nt]:=(bnt and $F0)or bto
     else bps[nt]:=(bnt and $0F) or (bto shl 4);
    end;
   end;
  end;
 end;pf24bit:begin
  bps:=bmp.scanline[0];
  move(bps^,cfrom,3);
  bmp.canvas.pixels[0,0]:=NewColor;
  bps:=bmp.scanline[0];
  move(bps^,cto,3);
  bmp.canvas.pixels[0,0]:=svColor;
  cfrom:=cfrom and $00ffffff;
  cto:=cto and $00ffffff;
  for iy:=0 to h_1 do begin
   bps:=bmp.scanline[iy];
   for ix:=0 to w_1 do begin
// load 3 bytes
    ix3:=ix*3;
    pint:=@(bps^[ix3]);
    c:=(pint^) and $00ffffff;
    if c=cfrom then begin
//move 3 bytes
     c:=pint^ and $FF000000;
     pint^:=c or cto;
    end;
   end;
  end;
 end else begin
  tempbmp:=TBitmap.Create;
  tempbmp.pixelformat:=bmp.pixelformat;
  tempbmp.Palette:=bmp.Palette;
  with tempbmp do begin
   Height := h;
   Width := w;
   R := Bounds(0, 0, w,h);
   Canvas.Brush.Color := NewColor;
   Canvas.BrushCopy(R, bmp, R,oldColor);
  end;
  bmp.assign(tempbmp);
  tempbmp.Free;
 end;end;
end;

Рисование на экране

procedure TForm1.Button1Click(Sender: TObject);
const
 SRest='Dinner Time';
var
 i,ix:integer;
 CS:TCanvas;
 ico:TIcon;
begin
 ix:=random(Screen.Height);
 CS:=TCanvas.Create;
 CS.Handle:=GetDC(0);
 CS.Brush.Style:=bsClear;
 CS.Font.Size:=24;
 CS.Font.Color:=clRed;
 CS.TextOut((Screen.Width-CS.TextWidth(SRest)) div 2,Screen.Height div 2,sRest);
 ico:=Application.Icon;
 for i:=0 to Screen.Height div ico.Height do begin
  CS.Draw(ix, Screen.Height-ico.Height*i,ico);
 end;
 ReleaseDC(0,CS.Handle);
 CS.Free;
end;
Начало

Главная страница | Продукты | Delphi | Юмор | Контакт