Конференция "Media" » Как вывести текст в центре Canvas по вертикали и горизонтали? [D7, WinXP]
 
  • 452 (12.01.08 16:14) [0]
    Как вывести текст в центре 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.
  • antonn © (12.01.08 16:23) [1]
    а что не получается?
  • 452 (12.01.08 16:38) [2]
    Нет нужно просто вывести текст по горизонтали и вертикали в заданном прямоугольнике на определенном канвасе.
    У меня не получается.
  • 452 (12.01.08 16:43) [3]
    Кстати опция DT_VCenter работает с выводом текста по вертикали если мы выводим только одну строку а мне нужно выводить многострочный текст (multi line text )
  • {RASkov} © (12.01.08 18:21) [4]
    > [3] 452   (12.01.08 16:43)

    Два варианта, ...думаю разберешься с комментариями

    procedure MyDrawText(DC: HDC; AR: TRect; {AWidth: Integer;} AStr: String);
    var R: TRect; WR, WAR, HR, HAR: Integer;
    begin
     R:=AR;
     //R.Right:=R.Left+AWidth;
     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{, 100}, Txt);
    end;

  • 452 (12.01.08 18:47) [5]
    Щас буду пробовать.
    А как сделать реакцию вроде DT_WORDBREAK (это срабатывает когда текст не помещается по горизонтали). А нужна реакция когда текст не помещается по вертикали в заданную область. В моей программе это нужно для тово чтобы текс который не помещается переносить на новое полотно.
  • {RASkov} © (12.01.08 19:18) [6]
    > [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
       { Private declarations }
     public
       { Public declarations }
     end;

    var
     Form1: TForm1;

    implementation

    {$R *.dfm}

    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.

  • 452 (13.01.08 13:18) [7]
    Первый ответ от

    > {RASkov} ©   (12.01.08 18:21) [4]
    >
    > > [3] 452   (12.01.08 16:43)
    >
    > Два варианта, ...думаю разберешься с комментариями

    просмотрел работает а второй к сожалению не могу так как я на нете в знакомого а у нево Delphi нет. на первый взгляд должно работать.

    http://ifolder.ru/4924581 Здесь выложил видео файл который делает моя программа.
    Нужно сделать такую функцию чтобы текст который не влазит в прямоугольник программа видела какой текст не поместился и выносила ево на новий Canvas вроде сообщения №2 (90% всех сообщений помещаются на экран а 10 имеют больше текста который уместить никак не получается для этово нужно текст переносить дальше)
    Заранее спасибо.
  • 452 © (15.01.08 19:17) [8]
    {RASkov} как с тобой связаться есть деловое предложение.
  • {RASkov} © (15.01.08 21:07) [9]
    > [8] 452 ©   (15.01.08 19:17)

    Ну попробуй :)
  • 452 © (17.01.08 18:10) [10]
    А у тебя есть ICQ
  • {RASkov} © (17.01.08 18:56) [11]
    есть
  • {RASkov} © (17.01.08 18:56) [12]
    :) не туда нажал )
    469970186
  • 452 © (21.01.08 13:42) [13]
    Ты кполучил письмо?
    И ты когда в аське бываешь.
  • 452 © (09.02.08 00:59) [14]
    Pleas return v icq
    Ты {RASkov} куда пропал с аськи
 
Конференция "Media" » Как вывести текст в центре Canvas по вертикали и горизонтали? [D7, WinXP]
Есть новые Нет новых   [133929   +473][b:0][p:0.005]