procedure TForm2.DrawShadows(WDepth, HDepth : Integer);
var
Dst, RgnBox: TRect;
hOldDC: HDC;
OffScreen: TBitmap;
Pattern: TBitmap;
Bits: array [0..7] of WORD;
begin
Bits[0]:=$0055;
Bits[1]:=$00aa;
Bits[2]:=$0055;
Bits[3]:=$00aa;
Bits[4]:=$0055;
Bits[5]:=$00aa;
Bits[6]:=$0055;
Bits[7]:=$00aa;
hOldDC:=Canvas.Handle;
Canvas.Handle:=GetWindowDC(Form1.Handle);
OffsetRgn(ShadeRgn, WDepth, HDepth);
GetRgnBox(ShadeRgn, RgnBox);
Read more »
Filed in Графика by admin | Февраль 27, 2008 | No Comments
procedure Spray(Canvas: TCanvas; x, y, r: Integer; Color: TColor);
var
rad, a: Single;
i: Integer;
begin
for i := 0 to 100 do
begin
a := Random * 2 * pi;
rad := Random * r;
Canvas.Pixels[x + Round(rad * Cos(a)), y + Round(rad * Sin(a))] := Color;
end;
end;
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if ssLeft in Shift then Spray(Image1.Canvas, x, y, 40, clRed);
end;
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if ssLeft in Shift then Spray(Image1.Canvas, x, y, 40, clRed);
end;
Filed in Графика by admin | Февраль 27, 2008 | No Comments
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Отображение текста с тегами форматирования
Рисует строку текста, содержащую теги форматирования, походие на теги HTML.
Поддерживаются следующие теги:
.. Полужирный
.. Наклонный
.. Подчёркнутый
.. Перечёркнутый
.. Увеличить ращмер шрифта на n единиц (по умолчанию 1)
.. Уменьшить шрифт на n единиц (по умолчанию 1)
.. Нижний индекс
.. Верхний индекс
Для правильного отображения внутри тегов и не должно располагаться других тегов
..
Установка параметров шрифта. Read more »
Filed in Графика by admin | Февраль 27, 2008 | No Comments
При использовании BitBtn Caption(текст) и картинка(bitmap) из файла не видны одновременно. Почему?
Это может происходить если картинка слишком велика. Класс TBitBtn сначала рисует картинку, а затем выводит текст над, под, слева или справа от картинки (в завивимости от свойства Layout). Если размер картинки такой же как у всей кнопки для вывода текста просто не остается места. Если Вам нужно получить кнопку такого же размера как Ваша картинка и видеть при этом надпись на кнопке Вам придется выводить текст надписи непосредственно на канву картинки.
var
bm : TBitmap;
OldBkMode : integer;
begin
bm := TBitmap.Create;
bm.Width := BitBtn1.Glyph.Width;
bm.Height := BitBtn1.Glyph.Height;
bm.Canvas.Draw(0, 0, BitBtn1.Glyph);
OldBkMode := SetBkMode(bm.Canvas.Handle, Transparent);
bm.Canvas.TextOut(0, 0, ‘The Caption’);
SetBkMode(bm.Canvas.Handle, OldBkMode);
BitBtn1.Glyph.Assign(bm);
end;
Filed in Графика by admin | Февраль 27, 2008 | No Comments
Вот небольшой участок кода из купленного мною CD-ROM “How To Book”. Файл с именем “HowUtils.Pas” содержит реализацию алгоритма “потухания” текста и обратного ему эффекта на холсте, откуда вы можете почерпнуть необходимую вам информацию.
function TFadeEffect.FadeInText(Target: TCanvas; X, Y: integer; FText: string):
TRect;
var
Pic: TBitmap;
W, H: integer;
PicRect, TarRect: TRect;
begin
Pic := TBitmap.Create;
Pic.Canvas.Font := Target.Font;
W := Pic.Canvas.TextWidth(FText);
H := Pic.Canvas.TextHeight(FText);
Pic.Width := W;
Pic.Height := H;
PicRect := Rect(0, 0, W, H);
TarRect := Rect(X, Y, X + W, Y + H);
Pic.Canvas.CopyRect(PicRect, Target, TarRect);
SetBkMode(Pic.Canvas.Handle, Transparent);
Pic.Canvas.TextOut(0, 0, FText);
FadeInto(Target, X, Y, Pic);
Pic.Free;
FadeInText := TarRect;
end;
procedure TFadeEffect.FadeOutText(Target: TCanvas; TarRect: TRect; Orig:
TBitmap);
var
Pic: TBitmap;
PicRect: TRect;
begin
Pic := TBitmap.Create;
Pic.Width := TarRect.Right - TarRect.Left;
Pic.Height := TarRect.Bottom - TarRect.Top;
PicRect := Rect(0, 0, Pic.Width, Pic.Height);
Pic.Canvas.CopyRect(PicRect, Orig.Canvas, TarRect);
FadeInto(Target, TarRect.Left, TarRect.Top, Pic);
Pic.Free;
end;
Filed in Графика by admin | Февраль 27, 2008 | No Comments