unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, ExtCtrls, StdCtrls, LCLType;
type
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
Image1: TImage;
procedure Button1Click(Sender: TObject);
procedure Edit1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure FormCreate(Sender: TObject);
procedure Image1DblClick(Sender: TObject);
private
Title: string;
Clickable: TRect;
procedure LoadImage;
procedure CalculateClickable;
procedure DrawCenterRectangle;
procedure WriteCenterText;
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.LoadImage;
const
ImageFile = 'img.png';
var
Tmp: TPicture;
begin
Image1.SetBounds(0, 0, Width, Height);
Tmp := TPicture.Create;
try
Tmp.LoadFromFile(ImageFile);
Image1.Canvas.StretchDraw(ClientRect, Tmp.Bitmap);
finally
Tmp.Free;
end;
end;
procedure TForm1.CalculateClickable;
var
W, H: Integer;
begin
Image1.Canvas.GetTextSize(Title, W, H);
Clickable.Left := (Width - W) div 2;
Clickable.Top := (Height - H) div 2;
Clickable.Width := W;
Clickable.Height := H;
Clickable.Inflate(2, 0);
end;
procedure ChangeColor(var Data: Byte);
const
Shift = 128; // 50% white
var
Temp: Integer;
begin
Temp := Data + Shift;
if (Temp > 255) then Temp := 255
else
if (Temp < 0) then Temp := 0;
Data := Temp;
end;
procedure TForm1.DrawCenterRectangle;
const
BoxWidth = 100;
BoxHeight = 20;
var
ScanData: Pointer;
Data24bit: PRGBTriple absolute ScanData;
Data32bit: PRGBQuad absolute ScanData;
X, Y: Integer;
begin
Image1.Picture.Bitmap.BeginUpdate;
for Y := Clickable.Top to Clickable.Bottom do
begin
{$ifdef Windows}
case Image1.Picture.Bitmap.PixelFormat of
pf24bit:
ScanData := Image1.Picture.Bitmap.ScanLine[Y] + Clickable.Left * 3;
pf32bit:
ScanData := Image1.Picture.Bitmap.ScanLine[Y] + Clickable.Left * 3;
end;
{$endif}
{$ifdef Linux}
ScanData := Image1.Picture.Bitmap.ScanLine[Y] + Clickable.Left * 4;
{$endif}
for X:= 0 to Clickable.Width do
begin
case Image1.Picture.Bitmap.PixelFormat of
pf24bit:
begin
begin
ChangeColor(Data24bit^.rgbtRed);
ChangeColor(Data24bit^.rgbtGreen);
ChangeColor(Data24bit^.rgbtBlue);
end;
{$ifdef Windows}
Inc(ScanData, 3);
{$endif}
{$ifdef Linux}
Inc(ScanData, 4);
{$endif}
end;
pf32bit:
begin
begin
ChangeColor(Data32bit^.rgbRed);
ChangeColor(Data32bit^.rgbGreen);
ChangeColor(Data32bit^.rgbBlue);
end;
Inc(ScanData, 4);
end;
end;
end;
end;
Image1.Picture.Bitmap.EndUpdate;
end;
procedure TForm1.WriteCenterText;
begin
Image1.Canvas.Brush.Style := bsClear;
Image1.Canvas.Font.Color := clBlack;
Image1.Canvas.TextOut(Clickable.Left+2, Clickable.Top, Title);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
LoadImage;
CalculateClickable;
DrawCenterRectangle;
WriteCenterText;
end;
procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState
);
begin
case Key of
VK_ESCAPE:
begin
Button1.Visible := True;
Edit1.Visible := False;
end;
VK_RETURN:
begin
if Edit1.Text <> '' then
begin
Title := Edit1.Text;
CalculateClickable;
LoadImage;
CalculateClickable;
DrawCenterRectangle;
WriteCenterText;
end;
Button1.Visible := True;
Edit1.Visible := False;
end;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Title := 'Double click here';
Edit1.Visible := False;
end;
procedure TForm1.Image1DblClick(Sender: TObject);
var
MouseXY: TPoint;
begin
MouseXY := ScreenToClient(Mouse.CursorPos);
if not(Clickable.Contains(MouseXY)) then Exit;
Button1.Visible := False;
Edit1.Left := Clickable.Left;
Edit1.Top := Clickable.Top;
Edit1.Width := Clickable.Width;
Edit1.Text := Title;
Edit1.Visible := True;
Edit1.SetFocus;
Edit1.SelectAll;
end;
end.
Recent
