Последние записи

made in programmersforum 4

Интенсив по Python: Работа с API и фреймворками 24-26 ИЮНЯ 2022. Знаете Python, но хотите расширить свои навыки?
Slurm подготовили для вас особенный продукт! Оставить заявку по ссылке - https://slurm.club/3MeqNEk

Online-курс Java с оплатой после трудоустройства. Каждый выпускник получает предложение о работе
И зарплату на 30% выше ожидаемой, подробнее на сайте академии, ссылка - ttps://clck.ru/fCrQw

28th
Апр

Перемещение текста по форме

Posted by Chas under Delphi, Исходники

как в paint

Stilet

unit Unit1;
{$mode objfpc}{$H+}
interface
uses

  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,

  StdCtrls, Menus;
type
  { TForm1 }

  TEdit2=class(StdCtrls.TEdit)

    Lab:TLabel;

  end;
  TForm1 = class(TForm)

    Image1: TImage;

    MainMenu1: TMainMenu;

    MenuItem1: TMenuItem;

    procedure Edit1Change(Sender: TObject);

    procedure Edit1KeyPress(Sender: TObject; var Key: char);

    procedure Image1Click(Sender: TObject);

    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;

      Shift: TShiftState; X, Y: Integer);

    procedure MenuItem1Click(Sender: TObject);

  private

    procedure LabClick(Sender: TObject);

    { private declarations }

  public

    { public declarations }

  end;
var

  Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.Image1Click(Sender: TObject);
begin
end;
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;

  Shift: TShiftState; X, Y: Integer);

var l:TLabel;

begin

  if tag=1 then begin

    l:=TLabel.Create(self);

    l.Parent:=self;

    l.Caption:='This is text';

    l.Transparent:=true;

    l.Font.Color:=clWhite;

    l.Font.Size:=32;

    l.AutoSize:=true;

    l.OnClick:=@LabClick;

    l.Top:=y;

    l.Left:=x;

    tag:=0;

  end;

end;
procedure TForm1.LabClick(Sender: TObject);

begin

 with TEdit2.Create(self) do begin

  Parent:=self;

  Left:=TLabel(Sender).Left;

  Top:=TLabel(Sender).Top;

  Width:=TLabel(Sender).Width;

  font.Size:=TLabel(Sender).font.Size;

  OnKeyPress:=@Edit1KeyPress;

  Lab:=TLabel(Sender);

  Show;

 end;

end;
procedure TForm1.Edit1Change(Sender: TObject);

begin
end;
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: char);

begin

 if key<>#13 then exit;

 with TEdit2(Sender) do begin

  Lab.Caption:=Text;

  Hide;

 end;

end;
procedure TForm1.MenuItem1Click(Sender: TObject);

begin

 Tag:=1;

end;
end.