unit aplanes_;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
TForm1 = class(TForm)
procedure FormPaint(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
sky, aplane: TBitMap; // битовые образы: небо и самолет
Read more »

procedure DrawTransparentBmp(Cnv: TCanvas; x,y: Integer; Bmp: TBitmap; clTransparent: TColor);
var
bmpXOR, bmpAND, bmpINVAND, bmpTarget: TBitmap;
oldcol: Longint;
begin
try
bmpAND := TBitmap.Create;
bmpAND.Width := Bmp.Width;
bmpAND.Height := Bmp.Height;
bmpAND.Monochrome := True;
oldcol := SetBkColor(Bmp.Canvas.Handle, ColorToRGB(clTransparent));
BitBlt(bmpAND.Canvas.Handle, 0, 0, Bmp.Width, Bmp.Height, Bmp.Canvas.Handle, 0, 0, SRCCOPY);
SetBkColor(Bmp.Canvas.Handle, oldcol);
Read more »

function MyGetMem(Size: DWORD): Pointer;
begin
Result := Pointer(GlobalAlloc(GPTR, Size));
end;

procedure MyFreeMem(p: Pointer);
begin
if p = nil then Exit;
GlobalFree(THandle(p));
end;

{ This code will fill a bitmap by stretching an image coming from a big bitmap on disk.

FileName.- Name of the uncompressed bitmap to read
DestBitmap.- Target bitmap where the bitmap on disk will be resampled.
BufferSize.- The size of a memory buffer used for reading scanlines from the physical bitmap on disk.
This value will decide how many scanlines can be read from disk at the same time, with always a
minimum value of 2 scanlines.
Read more »

unit Unit1;

interface

uses
Windows, Classes, SysUtils, Graphics, Forms;

type
TRGBArray = array[0..32767] of TRGBTriple;
PRGBArray = ^TRGBArray;

type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
FRegion: THandle;
function CreateRegion(Bmp: TBitmap): THandle;
end;

var
Form1: TForm1;

implementation

{$R *.dfm}
Read more »

Вот кусок одного моего класса, в котором есть две интересные вещицы - проецирование файлов в память и работа с битмэпом в памяти через указатель.

Сразу оговорюсь, что все это работает только под Win95/NT.

type
TarrRGBTriple = array[byte] of TRGBTriple;
ParrRGBTriple = ^TarrRGBTriple;

{организует битмэп размером SX,SY;true_color}

procedure TMBitmap.Allocate(SX, SY: integer);
var
DC: HDC;
begin
if BM <> 0 then
DeleteObject(BM); {удаляем старый битмэп, если был}
BM := 0;
PB := nil;
fillchar(BI, sizeof(BI), 0); Read more »

procedure TForm1.Button1Click(Sender: TObject);
var
TheIcon: TIcon;
TheBitmap: TBitmap;
begin
TheIcon := TIcon.Create;
TheIcon.LoadFromFile(’C:\Program Files\Borland\IcoCur32\EARTH.ICO’);
TheBitmap := TBitmap.Create;
TheBitmap.Height := TheIcon.Height;
TheBitmap.Width := TheIcon.Width;
TheBitmap.Canvas.Draw(0, 0, TheIcon);
Form1.Canvas.Draw(10, 10, TheBitmap);
TheBitmap.Free;
TheIcon.Free;
end;

Способ преобразования изображения размером 32×32 в иконку.

unit main;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls,
Forms, Dialogs, ExtCtrls, StdCtrls;

type

TForm1 = class(TForm)
Button1: TButton;
Image1: TImage;
Image2: TImage;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
Read more »

Чтобы преобразовать Icon в Bitmap используйте TImageList. для обратного преобразования замените метод AddIcon на Add, и метод GetBitmap на GetIcon.

function Icon2Bitmap(Icon: TIcon): TBitmap;
begin
with TImageList.Create (nil) do
begin
AddIcon (Icon);
Result := TBitmap.Create;
GetBitmap (0, Result);
Free;
end;
end;

procedure TIconShow.FileListBox1Click(Sender: TObject);
var

MyIcon: TIcon;
MyBitMap: TBitmap;
begin

MyIcon := TIcon.Create;
MyBitMap := TBitmap.Create;

try
{ получаем имя файла и связанную с ним иконку}
strFileName := FileListBox1.Items[FileListBox1.ItemIndex];
StrPCopy(cStrFileName, strFileName);
MyIcon.Handle := ExtractIcon(hInstance, cStrFileName, 0);

{ рисуем иконку на bitmap в speedbutton }
SpeedButton1.Glyph := MyBitMap;
SpeedButton1.Glyph.Width := MyIcon.Width;
SpeedButton1.Glyph.Height := MyIcon.Height;
SpeedButton1.Glyph.Canvas.Draw(0, 0, MyIcon);

SpeedButton1.Hint := strFileName;

finally
MyIcon.Free;
MyBitMap.Free;
end;
end;

function InvertBmp1(SourceBmp: TBitmap): TBitMap;
var
i, j: Longint;
tmp: TBitMap;
red, green, blue: Byte;
PixelColor: Longint;
begin
tmp := TBitmap.Create;
tmp.Width := SourceBmp.Width;
tmp.Height := SourceBmp.Height;
for i := 0 to SourceBmp.Width - 1 do
begin
for j := 0 to SourceBmp.Height - 1 do
begin
PixelColor := ColorToRGB(SourceBmp.Canvas.Pixels[i, j]);
red := PixelColor;
green := PixelColor shr 8;
blue := PixelColor shr 16;
red := 255 - red;
green := 255 - green;
blue := 255 - blue;
tmp.Canvas.pixels[i, j] := (red shl 8 + green) shl 8 + blue;
end;
end;
Result := tmp;
end;

function InvertBmp2(ABitmap : TBitmap) : TBitmap;
var
l_bmp : TBitmap;
begin
l_bmp := TBitmap.Create;
l_bmp.Width := ABitmap.Width;
l_bmp.Height := ABitmap.Height;
l_bmp.PixelFormat := ABitmap.PixelFormat;
BitBlt( l_bmp.Canvas.Handle, 0, 0, l_bmp.Width, l_bmp.Height,
ABitmap.Canvas.Handle, 0, 0, SRCINVERT );
result := l_bmp;
end;

{
Dieses ist eine ziemlich schnelle Methode, eine Farbumkehrung auf einem
Bitmap anzuwenden.
}

{
This is a very fast method to invert the colors of a bitmap.
}

function InvertBitmap(MyBitmap: TBitmap): TBitmap;
var
x, y: Integer;
ByteArray: PByteArray;
begin
MyBitmap.PixelFormat := pf24Bit;
for y := 0 to MyBitmap.Height - 1 do
begin
ByteArray := MyBitmap.ScanLine[y];
for x := 0 to MyBitmap.Width * 3 - 1 do
begin
ByteArray[x] := 255 - ByteArray[x];
end;
end;
Result := MyBitmap;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Image1.Picture.Bitmap := InvertBitmap(Image1.Picture.Bitmap);
Image1.Refresh;
end;

procedure loadgraphic(naam:string);
var
HResInfo: THandle;
BMF: TBitmapFileHeader;
MemHandle: THandle;
Stream: TMemoryStream;
ResPtr: PByte;
ResSize: Longint;
null:array [0..8] of char;
begin
strpcopy (null, naam);
HResInfo := FindResource(HInstance, null, RT_Bitmap);
ResSize := SizeofResource(HInstance, HResInfo);
MemHandle := LoadResource(HInstance, HResInfo);
ResPtr := LockResource(MemHandle);
Stream := TMemoryStream.Create;
try
Stream.SetSize(ResSize + SizeOf(BMF));
BMF.bfType := $4D42;
Stream.write(BMF, SizeOf(BMF));
Stream.write(ResPtr^, ResSize);
Stream.Seek(0, 0);
Bitmap:=tbitmap.create;
Bitmap.LoadFromStream(Stream);
finally
Stream.Free;
end;
FreeResource(MemHandle);
end;

Если вы рисуете на TImage….

Во-первых, вам нужно использовать Image1.Picture.bitmap, а не Image.Canvas. Причина кроется в том, что Image1.Picture.Bitmap имеет палитру, в Timage нет. Затем палитру необходимо назначить. Вот пример:

// Устанавливаем Width и Height перед использованием
// Image1.Picture c Bitmap Canvasvar

Bitmap: TBitmap;
begin
Bitmap:=TBitmap.Create;
Bitmap.LoadfromFile({’Whatever.bmp’});
Read more »

Cегодня вот… оживленно треплюсь с парнем, сидящим за соседним компом… и от возбуждения разговором слегка теряю равновесие и почти падаю на него :))… Он мне говорит: “отойди от меня…”, - “отойти на 20 пунктов?” - несмело интересуюсь я… “Нет”, - задумчиво продолжает он… - “отойди на 30 пикселей”…

Один из способов создания битмапа из массива пикселей заключается в использовании Windows API функции CreateDiBitmap(). Это позволит использовать один из многих форматов битмапа, которые Windows использует для хранения пикселей. Следующий пример создаёт 256-цветный битмап из массива пикселей. Битмап состит из 256 оттенков серого цвета плавно переходящих от белого к чёрному. Обратите внимание, что Windows резервирует первые и последние 10 цветов для системных нужд, поэтому Вы можете получить максимум 236 оттенков серого.
Read more »

const
PixelMax = 32768;

type
pPixelArray = ^TPixelArray;
TPixelArray = array [0..PixelMax-1] of TRGBTriple;

procedure RotateBitmap_ads(SourceBitmap: TBitmap;
out DestBitmap: TBitmap; Center: TPoint; Angle: Double);
var
cosRadians : Double;
inX : Integer;
inXOriginal : Integer;
inXPrime : Integer;
inXPrimeRotated : Integer;
inY : Integer;
inYOriginal : Integer; Read more »

procedure RotateBitmap(Bitmap: TBitmap; Angle: Double; BackColor: TColor);
type TRGB = record
B, G, R: Byte;
end;
pRGB = ^TRGB;
pByteArray = ^TByteArray;
TByteArray = array[0..32767] of Byte;
TRectList = array [1..4] of TPoint;

var x, y, W, H, v1, v2: Integer;
Dest, Src: pRGB;
VertArray: array of pByteArray;
Bmp: TBitmap;

procedure SinCos(AngleRad: Double; var ASin, ACos: Double);
begin
ASin := Sin(AngleRad);
ACos := Cos(AngleRad);
end;
Read more »

// Vektor von FromP nach ToP
// Vector from FromP to ToP

function TForm1.Vektor(FromP, Top: TPoint): TPoint;
begin
Result.x := Top.x - FromP.x;
Result.y := Top.y - FromP.y;
end;

// neue x Komponente des Verktors
// new x-component of the vector
function TForm1.xComp(Vektor: TPoint; Angle: Extended): Integer;
begin
Result := Round(Vektor.x * cos(Angle) - (Vektor.y) * sin(Angle));
end;

// neue Y-Komponente des Vektors
// new y-component of the vector
function TForm1.yComp(Vektor: TPoint; Angle: Extended): Integer;
begin
Result := Round((Vektor.x) * (sin(Angle)) + (vektor.y) * cos(Angle));
end;

Read more »

// This function stretches a bitmap with specified number of pixels
// in horizontal, vertical dimension
// Example Call : ResizeBmp(Image1.Picture.Bitmap , 200 , 200);

// Diese Funktion zerrt eine Bitmap in die anzugebenden Pixel
// Beispielaufruf : ResizeBmp(Image1.Picture.Bitmap , 200 , 200);

function TForm1.ResizeBmp(bitmp: TBitmap; wid, hei: Integer): Boolean;
var
TmpBmp: TBitmap;
ARect: TRect;
begin
Result := False;
try
TmpBmp := TBitmap.Create;
try
TmpBmp.Width := wid;
TmpBmp.Height := hei;
ARect := Rect(0,0, wid, hei);
TmpBmp.Canvas.StretchDraw(ARect, Bitmp);
bitmp.Assign(TmpBmp);
finally
TmpBmp.Free;
end;
Result := True;
except
Result := False;
end;
end;

Программист смотрит фильм “Чужой”:
- Ну запишись же, запишись.

var
Bitmap: TBitmap;
Source: TRect;
Dest: TRect;
begin
Bitmap := TBitmap.Create;
try
with Bitmap do
begin
Width := MyPaintBox.Width;
Height := MyPaintBox.Height;
Dest := Rect(0, 0, Width, Height);
end;
with MyPaintBox do
Source := Rect(0, 0, Width, Height);
Bitmap.Canvas.CopyRect(Dest, MyPaintBox.Canvas, Source);
Bitmap.SaveToFile(’MYFILE.BMP’);
finally
Bitmap.Free;
end;
end;

Вам необходимо две копии вашего изображения. Маску и само изображение. Маска является ничем иным, как изображением, состоящим из двух цветов. Черного для тех областей, которые вы хотите показать, и белого для прозрачных. Для Windows 3.1 маска изображения может быть черно-белой, и предназначена для определения размеров изображения. В Win95 черно-белая маска ни при каких обстоятельствах не работает, т.к. у нее должна быть та же глубина цветов, что и у самого изображения, которое вы хотите показать.

Изображение, которое вы хотите показать, должно содержать в прозрачных областях значение цвета, равное 0. Метод помещения изображения на экран такой же, как и в DOS. Маска AND экран, изображение OR или XOR с той же областью.

Ниже приведен код Delphi, позволяя сделать вышеописанное с помощью двух TBitmap.

Canvas.CopyMode := cmSrcAnd;
Canvas.CopyRect(TitleRect, BMask.Canvas, TitleRect);
{заполняем “пробелы” изображением}
Canvas.CopyMode := cmSrcPaint;
Canvas.CopyRect(TitleRect, BTitle.Canvas, TitleRect);

Пожалуй, это самый простой способ создания прозрачного изображения. Суть его в том, что маска создается автоматически во время выполнения программы, используя значение прозрачного цвета.

MaskBitmap := TBitmap.Create;
MaskBitmap.Assign(SrcBitmap);
MaskBitmap.Mask(FColor); //прозрачный цвет
BitBlt(DestBitmap.Canvas.Handle, x, y,
SrcBitmap.Width, SrcBitmap.Height,
MaskBitmap.Canvas.Handle, 0, 0, SRCAND);
BitBlt(DestBitmap.Canvas.Handle, x, y,
SrcBitmap.Width, SrcBitmap.Height,
SrcBitmap.Canvas.Handle, 0, 0, SRCINVERT);
MaskBitmap.Free;

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Вырезание эллиптической области на Bitmap

Зависимости: Classes, Graphics
Автор: Fenik, chook_nu@uraltc.ru, Новоуральск
Copyright: Собственное написание (Николай федоровских)
Дата: 1 июня 2002 г.
***************************************************** }

procedure EllipticBitmap(Bitmap: TBitmap; BackColor: TColor);
type
TRGB = record
B, G, R: Byte;
end;
pRGB = ^TRGB;
var
C: TRGB;
x, y: Integer;
Dest, Src: pRGB;
Bmp: TBitmap;
begin
Bitmap.PixelFormat := pf24Bit;
C.R := Lo(BackColor);
C.G := Lo(BackColor shr 8);
C.B := Lo((BackColor shr shr 8);
//создаём дополнительный Bitmap
Bmp := TBitmap.Create;
try Read more »

{
This tip show, how to get the filesize, width, height, bitcount and color used
from a bitmap.

Dieses Beispiel zeigt, wie man Dateigrosse, breite, hohe, Farbtiefe und Farbanzahl
von einem Bitmap ausliest.
}

procedure TForm1.Button1Click(Sender: TObject);
var
fileheader: TBitmapfileheader;
infoheader: TBitmapinfoheader;
s: TFilestream;
begin
s := TFileStream.Create(’c:\YourBitmap.bmp’, fmOpenRead);
try Read more »

procedure flip_horizontal(Quelle, Ziel: TBitMap);
begin
Ziel.Assign(nil);
Ziel.Width := Quelle.Width;
Ziel.Height := Quelle.Height;
StretchBlt(Ziel.Canvas.Handle, 0, 0, Ziel.Width, Ziel.Height, Quelle.Canvas.Handle,
0, Quelle.Height, Quelle.Width, Quelle.Height, srccopy);
end;
Read more »

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Инверсия всех цветов Bitmap

Зависимости: Graphics
Автор: Fenik, chook_nu@uraltc.ru, Новоуральск
Copyright: Собственное написание (Николай федоровских)
Дата: 1 июня 2002 г.
***************************************************** }

procedure InvertBitmap(Bitmap: TBitmap);
type
TRGB = record
B, G, R: Byte;
end;
pRGB = ^TRGB;
var
x, y: Integer;
Dest: pRGB;
begin Read more »

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Зеркальное отражение изображения

Зависимости: Windows, Graphics
Автор: Fenik, chook_nu@uraltc.ru, Новоуральск
Copyright: Автор: Федоровских Николай
Дата: 16 июля 2002 г.
***************************************************** }

procedure FlipBitmap(Bitmap: TBitmap; FlipHor: Boolean);
{Зеркальное отражение изображения.
Если FlipHor = True, то отражение по горизонтали,
иначе по вертикали.}
var
x, y, W, H: Integer;
Pixel_1, Pixel_2: PRGBTriple;
MemPixel: TRGBTriple;
begin Read more »

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Эффект ‘Мозаика’ (пикселизация)

Зависимости: Windows, Classes, Graphics
Автор: Fenik, chook_nu@uraltc.ru, Новоуральск
Copyright: Собственное написание (Николай федоровских)
Дата: 1 июня 2002 г.
***************************************************** }

procedure PixelsEffect(Bitmap: TBitmap; Hor, Ver: Word);
{функция разбивает изображение на прямоугольники (ширина - Hor; высота - Ver)
И закрашивает эти прямоугольники средним цветом,
используя среднеарифметическое составляющих}
Read more »

{
Diese Funktion liefert ein Bitmap eines RadioButton.

Wichtig:
Die Bitmap sollte nach Ausfuhrung der Funktion wieder freigegeben werden!
XP-Styles werden erst ab Delphi7 unterstutzt.
}

Code:{$IFDEF VER150}

uses
Themes;
{$ENDIF}

function GetRadioButtonBitmap(Checked, Hot : boolean; BgColor : TColor): TBitmap;
const
CtrlState : array[boolean] of integer = (DFCS_BUTTONRADIO,
DFCS_BUTTONRADIO or DFCS_CHECKED);
var
CBRect : TRect;
{$IFDEF VER150}
Details : TThemedElementDetails;
{$ENDIF}
BgOld : TColor;
ChkBmp : TBitmap;
ThemeOK : boolean;
x, x2, y : integer;
begin Read more »

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Эффект ‘Иней’ (разброс)

Зависимости: Classes, Graphics
Автор: Fenik, chook_nu@uraltc.ru, Новоуральск
Copyright: Собственное написание (Николай федоровских)
Дата: 1 июня 2002 г.
***************************************************** }

procedure Disorder(Bitmap: TBitmap; Hor, Ver: Integer; BackColor: TColor);

function RandomInRadius(Num, Radius: Integer): Integer;
begin
if Random(2) = 0 then
Result := Num + Random(Radius)
else
Result := Num - Random(Radius);
end;
Read more »

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Вращение изображения на заданный угол

Зависимости: Windows, Classes, Graphics
Автор: Fenik, chook_nu@uraltc.ru, Новоуральск
Copyright: Автор Федоровских Николай
Дата: 2 июня 2002 г.
***************************************************** }

procedure RotateBitmap(Bitmap: TBitmap; Angle: Double; BackColor: TColor);
type
TRGB = record
B, G, R: Byte;
end;
pRGB = ^TRGB;
pByteArray = ^TByteArray;
TByteArray = array[0..32767] of Byte;
TRectList = array[1..4] of TPoint;
Read more »