Пример демонстрирует вывод теста случайным образом на форме под определённым углом. Добавляем в форму компонент TButton и в событие OnClick следующий код:
procedure TForm1.Button1Click(Sender: TObject);
var
logfont: TLogFont;
font: Thandle;
count: integer;
begin
LogFont.lfheight := 20;
logfont.lfwidth := 20;
logfont.lfweight := 750;
LogFont.lfEscapement := -200;
logfont.lfcharset := 1;
logfont.lfoutprecision := out_tt_precis;
logfont.lfquality := draft_quality;
logfont.lfpitchandfamily := FF_Modern;
font := createfontindirect(logfont);
SelectObject(Form1.canvas.handle, font);
SetTextColor(Form1.canvas.handle, rgb(0, 0, 200));
SetBKmode(Form1.canvas.handle, transparent);
for count := 1 to 10 do
begin
Canvas.TextOut(Random(form1.width), Random(form1.height), ‘Delphi World’);
SetTextColor(form1.canvas.handle, rgb(Random(255), Random(255), Random(255)));
end;
DeleteObject(font);
end;
Filed in Графика by admin | Февраль 27, 2008 | No Comments
Используй вызов DrawTextEx, установив в параметре dwDTFormat значение DT_PATH_ELLIPSIS.
procedure TForm1.FormPaint(Sender: TObject);
var
r: TRect;
begin
r := Rect(20, 20, 110, 70);
// DT_PATH_ELLIPSIS or DT_WORD_ELLIPSIS or DT_END_ELLIPSIS
DrawTextEx(Form1.Canvas.Handle, ‘Delphi World - это круто!!!’,
25, r, DT_WORD_ELLIPSIS, nil);
end;
Filed in Графика by admin | Февраль 27, 2008 | No Comments
function DrawDisabledText (Canvas : tCanvas; Str: PChar; Count: Integer;
var Rect: TRect; Format: Word): Integer;
begin
SetBkMode(Canvas.Handle, TRANSPARENT);
OffsetRect(Rect, 1, 1);
Canvas.Font.color := ClbtnHighlight;
DrawText(Canvas.Handle, Str, Count, Rect, Format);
Canvas.Font.Color := ClbtnShadow;
OffsetRect(Rect, -1, -1);
DrawText(Canvas.Handle, Str, Count, Rect, Format);
end;
Filed in Графика by admin | Февраль 27, 2008 | No Comments
procedure TForm1.FormPaint(Sender: TObject);
var
x, y: integer;
bm: TBitMap;
begin
Form1.ClientWidth := 200;
Form1.ClientHeight := 100;
randomize;
for x := 0 to 199 do
for y := 0 to 99 do
if random(3) = 1 then
Form1.Canvas.Pixels[x,y] := clGreen
else
Form1.Canvas.Pixels[x,y] := clLime;
bm := TBitMap.Create;
bm.Width := 200;
bm.Height := 100;
with bm.Canvas do
begin
Brush.Color := clGreen;
FillRect(ClipRect);
Font.name := ‘Arial’;
Font.Size := 50;
Font.Color := clGray;
Font.Style := [fsBold];
TextOut((bm.Width - TextWidth(’Text’)) div 2,
(bm.Height - TextHeight(’Text’)) div 2, ‘Text’);
end;
Form1.Canvas.CopyMode := cmSrcPaint;
Form1.Canvas.CopyRect(bm.Canvas.ClipRect, bm.Canvas,
bm.Canvas.ClipRect);
bm.Destroy;
end;
Filed in Графика by admin | Февраль 27, 2008 | No Comments
{
Enables you do draw a line if for some reason you
cannot use the delphi LineTo procedure.
For example, for drawing higher resolution lines
or drawing lines in 2D arrays.
}
procedure DrawLine(APoint1, APoint2: TPoint; ACanvas: TCanvas);
var
Lpixel, LMaxAxisLength: integer;
LRatio: Real;
begin
LMaxAxisLength := Max(abs(APoint1.X - APoint2.X), abs(APoint1.Y - APoint2.Y));
for Lpixel := 0 to LMaxAxisLength do
begin
LRatio := Lpixel / LMaxAxisLength;
ACanvas.Pixels[APoint1.X + Round((APoint2.X - APoint1.X) * LRatio),
APoint1.Y + Round((APoint2.Y - APoint1.Y) * LRatio)] :=
ACanvas.Pen.Color;
end;
end;
Read more »
Filed in Графика by admin | Февраль 27, 2008 | No Comments