Drawing outside form

here's one way of doing it...

https://www.experts-exchange.com/questions/20706798/Drawing-outside-form.html

Zhaaws, it works, but when I move the form, it left "traces". The line is not moved.

Any workaround for this?

Hi dudup,

This is my crude version of what I think that you want.
I have provided both the .pas and the .dfm below so that you can
easily assemble the program.  If  you need help in that regard then
request it from me.

delphi3

// Note:  this works because the user has first edited the bitmap so that the
// the margins of the shape are black, that those black margins are not connected
// to interior black margins where the search for a path would lead to the interior.


   

unit BorderOfIrregularShapeUnit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, Menus;
type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Image1: TImage;
    Image2: TImage;
    Label4: TLabel;
    Label5: TLabel;
    RadioGroup1: TRadioGroup;
    SaveDialog1: TSaveDialog;

    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure EraseCanvas(Sender: TObject);
    procedure ExtractArray2(Sender: TObject);
    procedure RaisedPolyLine2(aPoints: array of TPoint; Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    { Private declarations }
  private

  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  RadioGroup1.ItemIndex := 0;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  BitMapFile: string;
  BitMap1: TBitMap;
begin
  BitMap1 := TBitMap.Create;
  try
    if RadioGroup1.ItemIndex = 0 then
      BitMapFile := 'E1';
    if RadioGroup1.ItemIndex = 1 then
      BitMapFile := 'E2';
    BitMap1.LoadFromFile(ExtractFilePath(Application.exeName) + BitMapFile + '.bmp');
    Form1.Image1.Picture.Graphic := Bitmap1;
    Show();
    EraseCanvas(Self); // clear off canvas area for new drawing
    Form1.Image2.Picture.Graphic := Bitmap1;
    Show();
    ExtractArray2(Self);
    Form1.Image1.Picture.Graphic := Bitmap1;
    Show();
  finally
    BitMap1.Free;
  end;
end;


procedure TForm1.ExtractArray2(Sender: TObject);
var
  IA, IB, C, Count, Tx, Ty: Integer;
  DaPoints: array[0..4096] of TPoint;
  DaP: Tpoint;
  Checker: Boolean;
begin
  C := 0;
// seeking a black point to begin with
  for IA := 1 to Form1.Image1.Picture.Width do
  begin
    for IB := 1 to Form1.Image1.Picture.Height do
    begin
      if Form1.Image1.Canvas.Pixels[IA, IB] = clBlack then
      begin
        DaP.x := IA;
        DaP.y := IB;
        DaPoints[C] := DaP; // this is the last one on the image, furthest down, right
      end;
    end;
  end;
  while C < 600 do // an arbitrary number to go around the shape
  begin
    Checker := False;
    Tx := DaP.x; Ty := DaP.y;
    // using an else if conditional
    if (Form1.Image1.Canvas.Pixels[Tx, Ty - 1] = clBlack) and (Checker = False) then
    begin Ty := Ty - 1; Checker := True; end //up

    else if (Form1.Image1.Canvas.Pixels[Tx + 1, Ty] = clBlack) and (Checker = False) then
    begin Tx := Tx + 1; Checker := True; end //right

    else if (Form1.Image1.Canvas.Pixels[Tx, Ty + 1] = clBlack) and (Checker = False) then
    begin Ty := Ty + 1; Checker := True; end //down

    else if (Form1.Image1.Canvas.Pixels[Tx - 1, Ty] = clBlack) and (Checker = False) then
    begin Tx := Tx - 1; Checker := True; end //left

    else if (Form1.Image1.Canvas.Pixels[Tx - 1, Ty - 1] = clBlack) and (Checker = False) then
    begin Tx := Tx - 1; Ty := Ty - 1; Checker := True; end //up left

    else if (Form1.Image1.Canvas.Pixels[Tx + 1, Ty - 1] = clBlack) and (Checker = False) then
    begin Tx := Tx + 1; Ty := Ty - 1; Checker := True; end //up right

    else if (Form1.Image1.Canvas.Pixels[Tx + 1, Ty + 1] = clBlack) and (Checker = False) then
    begin Tx := Tx + 1; Ty := Ty + 1; Checker := True; end //down right

    else if (Form1.Image1.Canvas.Pixels[Tx - 1, Ty + 1] = clBlack) and (Checker = False) then
    begin Tx := Tx - 1; Ty := Ty + 1; Checker := True; end; // down left


    C := C + 1; DaP.x := Tx; DaP.y := Ty; DaPoints[C] := DaP;
    Form1.Image1.Canvas.Pixels[Tx, Ty] := clWhite;
  end;
  for COUNT := C to 4096 do
  begin
    DaPoints[COUNT] := DaPoints[0];
  end;
  RaisedPolyLine2(DaPoints, Self);
end;


procedure TForm1.EraseCanvas(Sender: TObject);
begin
  with Canvas do
  begin
    Brush.color := ClMenu;
    Pen.Color := ClMenu;
    FillRect(Rect(0, 0, 270, 160)); // a tad bigger than the form of Image2
  end;
end;


procedure TForm1.RaisedPolyLine2(aPoints: array of TPoint; Sender: TObject);
var
  i: Integer;
begin
  // could have used just the canvas and no image

  if Length(aPoints) > 0 then
    Image2.Canvas.MoveTo(aPoints[0].x, aPoints[0].y);
  for i := 1 to Length(aPoints) - 1 do
  begin
    if aPoints[i - 1].y < aPoints[i].y then //Down always black
      Image2.Canvas.Pen.Color := clBlack
    else if aPoints[i - 1].y > aPoints[i].y then //Up always white
      Image2.Canvas.Pen.Color := clWhite
    else if aPoints[i - 1].x < aPoints[i].x then //Right
      Image2.Canvas.Pen.Color := clWhite
    else //Left (or no movement)
      Image2.Canvas.Pen.Color := clblack;
    Image2.Canvas.LineTo(aPoints[i].x, aPoints[i].y);
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  if SaveDialog1.Execute then
  begin
    SaveDialog1.Filter := 'Bmp files (*.bmp)|*.BMP';
    Image2.Picture.SaveToFile(SaveDialog1.Filename + '.bmp');
  end;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  Application.Terminate;
end;

end.






the .dfm as text is below


object Form1: TForm1
  Left = 183
  Top = 124
  Width = 676
  Height = 440
  Caption = 'Raised Border for Shapes Outlined First in Black'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -14
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 120
  TextHeight = 16
  object Image1: TImage
    Left = 0
    Top = 236
    Width = 441
    Height = 189
  end
  object Label4: TLabel
    Left = 457
    Top = 236
    Width = 107
    Height = 16
    Caption = '<< Original Image '
  end
  object Label5: TLabel
    Left = 449
    Top = 10
    Width = 186
    Height = 16
    Caption = '<< Image Appearing as Raised'
  end
  object Image2: TImage
    Left = 0
    Top = 16
    Width = 441
    Height = 188
  end
  object Button1: TButton
    Left = 506
    Top = 256
    Width = 92
    Height = 31
    Caption = 'Open'
    TabOrder = 0
    OnClick = Button1Click
  end
  object Button2: TButton
    Left = 506
    Top = 305
    Width = 92
    Height = 31
    Caption = 'SavePicture'
    TabOrder = 1
    OnClick = Button2Click
  end
  object RadioGroup1: TRadioGroup
    Left = 480
    Top = 49
    Width = 129
    Height = 96
    Caption = 'Select File Name'
    Items.Strings = (
      'E1'
      'E2')
    TabOrder = 2
  end
  object Button3: TButton
    Left = 506
    Top = 354
    Width = 92
    Height = 31
    Caption = 'Close'
    TabOrder = 3
    OnClick = Button3Click
  end
  object SaveDialog1: TSaveDialog
    Filter = 'BmpFile|*.bmp'
    Left = 384
    Top = 160
  end
end