-
Как вывести текст в центре Canvas по вертикали и горизонтали? С помощью функции DrawText() uses MyIni; var FrmMain: TFrmMain; miy1,mix1,miy2,mix2,mzx,mzy,mrx,mry:integer; down:boolean; implementation
procedure TFrmMain.FormCreate(Sender: TObject); begin try mix1:=ReadIniDataInt('Option','PTX1'); mix2:=ReadIniDataInt('Option','PTX2'); miy1:=ReadIniDataInt('Option','PTY1'); miy2:=ReadIniDataInt('Option','PTY2'); mzx:=ReadIniDataInt('Option','PZX'); mzy:=ReadIniDataInt('Option','PZY'); mrx:=ReadIniDataInt('Option','PRX'); mry:=ReadIniDataInt('Option','PRY'); except end; end;
procedure TFrmMain.CalcuateTextPosition(const Caption: string; var TRC: TRect;BiDiFlags: Integer); var TB: TRect; TS, TP: TPoint; begin with Canvas do begin TB := Rect(0, 0, TRC.Right + TRC.Left, TRC.Top + TRC.Bottom); DrawText(Handle, PChar(Caption), Length(Caption), TB, DT_CALCRECT or BiDiFlags); TS := Point(TB.Right - TB.Left, TB.Bottom - TB.Top); TP.X := ((TRC.Right - TRC.Left) - TS.X + 1) div 2; TP.Y := ((TRC.Bottom - TRC.Top) - TS.Y + 1) div 2; OffsetRect(TB, TP.X + TRC.Left, TP.Y + TRC.Top); TRC := TB; end; end;
procedure TFrmMain.BtnPaintClick(Sender: TObject); Const StrSample='Тестове повідомленняВаша може бути тут.';//+#13+'А тут наша :)'+#13+'Розробка програмного забезпечення'+#13+'---------'+#13+'Домашній телефон: +380687093270'+#13+'Запитувати Ігоря'; var str:string; R: TRect; BiDiFlags: Longint; Bitmap:TBitmap; begin try Bitmap:=TBitmap.Create; Bitmap.LoadFromFile('Fon.BMP'); str:='Інформація'; //////////////////////// //miy1 (Bitmap.Height div 2) R := Rect(mix1,miy1,mix2,miy2);//700,480); Bitmap.Canvas.Brush.Style:=bsClear; Bitmap.Canvas.Font.Name := 'Arial'; Bitmap.Canvas.Font.Size:=20; Bitmap.Canvas.Pen.Width:=4; Bitmap.Canvas.Rectangle(R.Left - 2, R.Top - 2, R.Right + 2, R.Bottom + 2); Bitmap.Canvas.Font.Color:=clblack; //uFormat dt_WordBreak or //R := ClientRect; //DrawText(Bitmap.Canvas.Handle, PChar(StrSample), Length(StrSample), R,DT_CENTER or DT_VCENTER or BiDiFlags); DrawText(Bitmap.Canvas.Handle,PChar(StrSample),-1,R, DT_WORDBREAK or DT_CENTER or DT_VCENTER); Image.Canvas.StretchDraw(Rect(0,0,Image.Width,Image.Height),Bitmap); Bitmap.Free; finally end; end;
procedure TFrmMain.Button1Click(Sender: TObject); var TB: TRect; TS, TP: TPoint; Caption: string; BiDiFlags: Integer; TRC: TRect; Bitmap:TBitmap; bmp: TBitmap; begin Bitmap:=TBitmap.Create; bmp := TBitmap.Create; Bitmap.LoadFromFile('Fon.BMP'); Caption:='Тестове повідомлення'+#13+'Ваша може бути тут.'+#13+'А тут наша :)'+#13+'Розробка програмного забезпечення'+#13+'---------'+#13+'Домашній телефон: +380687093270'+#13+'Запитувати Ігоря'; Bitmap.Canvas.Brush.Style:=bsClear; Bitmap.Canvas.Font.Name := 'Arial'; Bitmap.Canvas.Font.Size:=20; Bitmap.Canvas.Pen.Width:=4; Bitmap.Canvas.Font.Color:=clblack; TRC:=Bitmap.Canvas.ClipRect; TB := Rect(0, 0, TRC.Right + TRC.Left, TRC.Top + TRC.Bottom); DrawText(bmp.Handle, PChar(Caption), Length(Caption), TB, DT_CALCRECT or BiDiFlags); Image.Canvas.StretchDraw(Rect(0,0,Image.Width,Image.Height),bmp); TS := Point(TB.Right - TB.Left, TB.Bottom - TB.Top); TP.X := ((TRC.Right - TRC.Left) - TS.X + 1) div 2; TP.Y := ((TRC.Bottom - TRC.Top) - TS.Y + 1) div 2; OffsetRect(TB,TP.X,TP.Y+TRC.Top); Bitmap.Canvas.Rectangle(TB.Left - 2, TB.Top - 2, TB.Right + 2, TB.Bottom + 2); //DrawText(Bitmap.Canvas.Handle, PChar(Caption),Length(Caption), TB,DT_CENTER or DT_VCENTER or DT_NOCLIP); //Image.Canvas.StretchDraw(Rect(0,0,Image.Width,Image.Height),Bitmap); Bitmap.Free; bmp.Free; end; // DT_CALCRECT) procedure TFrmMain.Button2Click(Sender: TObject); var Bitmap,bm:TBitmap; TB: TRect; Vans:String; i:integer; begin Vans:='Test TestTestTest'+#13+'TestTestTestTestTestTest'; Bitmap:=TBitmap.Create; //bm:=TBitmap.Create; Bitmap.LoadFromFile('Fon.BMP'); //bm.LoadFromFile('Fon.BMP'); Bitmap.Canvas.Brush.Style:=bsClear; Bitmap.Canvas.Font.Name := 'Arial'; Bitmap.Canvas.Font.Size:=20; Bitmap.Canvas.Pen.Width:=4; Bitmap.Canvas.Font.Color:=clblack; //bm.Canvas.Font:=Bitmap.Canvas.Font; TB:=Rect(14,122,701,483); //i:=DrawText(bm.Canvas.Handle, PChar(Vans),Length(Vans), TB,DT_CENTER or DT_WORDBREAK); //TB.Top:=i; //Caption:=IntToStr(i); DrawText(Bitmap.Canvas.Handle, PChar(Vans),Length(Vans), TB,DT_CENTER or DT_WORDBREAK); Bitmap.Canvas.Rectangle(TB.Left - 2, TB.Top - 2, TB.Right + 2, TB.Bottom + 2); Image.Canvas.StretchDraw(Rect(0,0,Image.Width,Image.Height),Bitmap); Bitmap.Free; //bm.Free; end; end.
-
а что не получается?
-
Нет нужно просто вывести текст по горизонтали и вертикали в заданном прямоугольнике на определенном канвасе. У меня не получается.
-
Кстати опция DT_VCenter работает с выводом текста по вертикали если мы выводим только одну строку а мне нужно выводить многострочный текст (multi line text )
-
> [3] 452 (12.01.08 16:43)
Два варианта, ...думаю разберешься с комментариями procedure MyDrawText(DC: HDC; AR: TRect; AStr: String);
var R: TRect; WR, WAR, HR, HAR: Integer;
begin
R:=AR;
DrawText(DC, PChar(AStr), -1, R, DT_CALCRECT or DT_WORDBREAK or DT_CENTER);
WAR:=AR.Right-AR.Left;
WR:=R.Right-R.Left;
HAR:=AR.Bottom-AR.Top;
HR:=R.Bottom-R.Top;
R.Left:=AR.Left+((WAR-WR) div 2);
R.Right:=R.Left+WR;
R.Top:=AR.Top+((HAR-HR) div 2);
R.Bottom:=R.Top+HR;
DrawText(DC, PChar(AStr), -1, R, DT_WORDBREAK or DT_CENTER);
end;
procedure TForm1.Button1Click(Sender: TObject);
const Txt = 'I?aiu aeeiiu oaeno iiiaino?i?iue oaeie aio aeeiiue oaeno io?ii aey auaiaa oaenoa uaeieaieeuiaai uaau?aau? uaa?ua';
begin
MyDrawText(Canvas.Handle, Canvas.ClipRect, Txt);
end;
-
Щас буду пробовать. А как сделать реакцию вроде DT_WORDBREAK (это срабатывает когда текст не помещается по горизонтали). А нужна реакция когда текст не помещается по вертикали в заданную область. В моей программе это нужно для тово чтобы текс который не помещается переносить на новое полотно.
-
> [5] 452 (12.01.08 18:47) > В моей программе это нужно для тово чтобы текс который > не помещается переносить на новое полотно.
Вот глянь, может чего и найдешь для себя: DFM:object Form1: TForm1
Left = 197
Top = 110
Width = 856
Height = 478
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object Button1: TButton
Left = 84
Top = 4
Width = 75
Height = 25
Caption = 'DrawText'
TabOrder = 0
OnClick = Button1Click
end
object Button2: TButton
Left = 4
Top = 4
Width = 75
Height = 25
Caption = 'PageText'
TabOrder = 1
OnClick = Button2Click
end
object Edit2: TLabeledEdit
Left = 488
Top = 6
Width = 53
Height = 21
EditLabel.Width = 86
EditLabel.Height = 13
EditLabel.Caption = 'Количество раз: '
LabelPosition = lpLeft
TabOrder = 3
Text = '10'
end
object LabeledEdit1: TLabeledEdit
Left = 656
Top = 6
Width = 53
Height = 21
EditLabel.Width = 87
EditLabel.Height = 13
EditLabel.Caption = 'Размер шрифта: '
LabelPosition = lpLeft
TabOrder = 4
Text = '8'
end
object CheckBox1: TCheckBox
Left = 164
Top = 8
Width = 17
Height = 17
TabOrder = 5
end
object Edit1: TLabeledEdit
Left = 216
Top = 6
Width = 177
Height = 21
EditLabel.Width = 33
EditLabel.Height = 13
EditLabel.Caption = 'Текст:'
LabelPosition = lpLeft
TabOrder = 2
Text = 'Длинная строка из кучи слов '
end
end PAS:unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
StdCtrls, ExtCtrls, Buttons, Dialogs;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Edit1: TLabeledEdit;
Edit2: TLabeledEdit;
LabeledEdit1: TLabeledEdit;
CheckBox1: TCheckBox;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
public
end;
var
Form1: TForm1;
implementation
function GetLongStr(const FNoSpace: Boolean=False): String;
var N: Integer; S: String;
begin
S:=Form1.Edit1.Text;
if FNoSpace then for N := Length(S) downto 1 do if S[N]=' ' then Delete(S, N, 1);
for N:= 1 to StrToIntDef(Form1.Edit2.Text, 10) do Result:=Result+IntToStr(N)+S;
end;
function DivStr(var S: String; R: TRect): String;
var Flags: LongInt;
begin
Flags:=DT_WORDBREAK or DT_MODIFYSTRING or DT_EDITCONTROL or DT_END_ELLIPSIS;
InflateRect(R, -4, -4);
Result:=Copy(S, 1, Length(S));
DrawTextEx(Form1.Canvas.Handle, PChar(S), -1, R, Flags, nil);
S:=StrPas(PChar(S));
if Length(Result)>=(Length(S)+3) then Delete(Result, 1, Length(S)-3) else Result:='';
end;
function DivStrEx(var S: String; R: TRect; const FNoDraw: Boolean=True): String;
var Flags: LongInt;
begin
Flags:=DT_MODIFYSTRING or DT_EDITCONTROL or DT_WORD_ELLIPSIS;
if FNoDraw then Flags:=DT_CALCRECT or Flags;
InflateRect(R, -4, -4);
Result:=Copy(S, 1, Length(S));
DrawText(Form1.Canvas.Handle, PChar(Result), -1, R, Flags);
Result:=StrPas(PChar(Result));
while Result[Length(Result)]='.' do Delete(Result, Length(Result), 1);
if Length(S)>=(Length(Result)) then Delete(S, 1, Length(Result)) else S:='';
end;
procedure TForm1.Button1Click(Sender: TObject);
var PS: PChar; N: Integer; R: Trect;
begin
PS:=PChar(GetLongStr(CheckBox1.Checked));
Canvas.Pen.Width:=2;
R:=Canvas.ClipRect; Canvas.Brush.Style:=bsSolid; Canvas.Brush.Color:=Color;
Canvas.FillRect(R); Repaint; Canvas.Font.Size:=StrToIntDef(LabeledEdit1.Text, 8);
Canvas.Brush.Style:=bsClear; Canvas.Pen.Color:=clBlue; Canvas.Rectangle(R);
INC(R.Left, 4); INC(R.Top, 35);
N:=DrawText(Canvas.Handle, PS, -1, R, DT_CALCRECT or DT_WORDBREAK);
Canvas.Pen.Color:=clRed; Canvas.Rectangle(R);
DrawText(Canvas.Handle, PS, -1, R, DT_WORDBREAK);
R:=Canvas.ClipRect; INC(R.Top, N+65); INC(R.Left, 4); DEC(R.Right, 4); DEC(R.Bottom, 4);
Canvas.Pen.Color:=clGreen; Canvas.Rectangle(R);
DrawText(Canvas.Handle, PS, -1, R, DT_WORDBREAK or DT_CENTER);
end;
procedure TForm1.Button2Click(Sender: TObject);
procedure ModifRect(var R: TRect);
var W, H: Integer;
begin
W:=R.Right-R.Left; H:=R.Bottom-R.Top;
if (R.Right+W>ClientWidth-10) then begin
INC(R.Top, H+10);
R.Bottom:=R.Top+H;
R.Left:=10;
R.Right:=130;
end else begin
INC(R.Left, W+10);
R.Right:=R.Left+W;
end;
end;
var PS: String; R: TRect; N: Integer;
begin
PS:=GetLongStr(CheckBox1.Checked); N:=0; Canvas.Pen.Width:=1;
R:=Rect(10, 35, 130, 230);
Canvas.Brush.Style:=bsSolid; Canvas.Brush.Color:=Color; Canvas.FillRect(Canvas.ClipRect);
Repaint; Canvas.Font.Size:=StrToIntDef(LabeledEdit1.Text, 8);
repeat
Canvas.Brush.Style:=bsSolid; Canvas.Brush.Color:=clGray;
Canvas.Pen.Color:=clGray;
Canvas.Rectangle(R.Left+4, R.Top+4, R.Right+4, R.Bottom+4);
Canvas.Brush.Style:=bsSolid; Canvas.Brush.Color:=clWhite;
Canvas.Pen.Color:=clBlack;
Canvas.Rectangle(R);
Canvas.Brush.Style:=bsClear;
PS:=DivStr(PS, R);
ModifRect(R);
INC(N);
until PS='';
Caption:='Страниц: '+IntToStr(N);
end;
end.
-
Первый ответ от > {RASkov} © (12.01.08 18:21) [4] > > > [3] 452 (12.01.08 16:43) > > Два варианта, ...думаю разберешься с комментариями
просмотрел работает а второй к сожалению не могу так как я на нете в знакомого а у нево Delphi нет. на первый взгляд должно работать. http://ifolder.ru/4924581 Здесь выложил видео файл который делает моя программа. Нужно сделать такую функцию чтобы текст который не влазит в прямоугольник программа видела какой текст не поместился и выносила ево на новий Canvas вроде сообщения №2 (90% всех сообщений помещаются на экран а 10 имеют больше текста который уместить никак не получается для этово нужно текст переносить дальше) Заранее спасибо.
-
{RASkov} как с тобой связаться есть деловое предложение.
-
> [8] 452 © (15.01.08 19:17)
Ну попробуй :)
-
А у тебя есть ICQ
-
есть
-
:) не туда нажал ) 469970186
-
Ты кполучил письмо? И ты когда в аське бываешь.
-
Pleas return v icq Ты {RASkov} куда пропал с аськи
|