?
Solved

Drawing outside form

Posted on 2005-03-01
4
Medium Priority
?
252 Views
Last Modified: 2010-04-05
Hello,

Is it possible to draw something outside the form area? I am planning to draw a "drop shadow" effect into a form.

There is a component called LDMFormShadow from LMDTools (http://www.lmdtools.com) that can give drop shadow when you drop that component. But the shadow effect is not good.

I need to figure out how to do this btw.

Thanks,
0
Comment
Question by:dudup
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
4 Comments
 
LVL 13

Expert Comment

by:BlackTigerX
ID: 13429735
0
 
LVL 11

Accepted Solution

by:
ZhaawZ earned 400 total points
ID: 13430049
An example of drawing a line outside a form 3 pixels below the form. I think that this will not help to draw a shadow, it`s just an example of drawing outside a form.


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs;

type
  TForm1 = class(TForm)
  private
    procedure WndProc (var msg : TMessage); override;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.WndProc;
var
  dc : hdc;
  pts : array [0..1] of tpoint;
begin
inherited;
if msg.Msg = wm_move then begin
  dc := GetWindowDC(GetDesktopWindow);
  pts[0] := Point(BoundsRect.Left, BoundsRect.Bottom + 3);
  pts[1] := Point(BoundsRect.Right, BoundsRect.Bottom + 3);
  Polyline(dc, pts, 2);
  ReleaseDC(GetDesktopWindow, dc);
end;
end;

end.
0
 

Author Comment

by:dudup
ID: 13430247
Zhaaws, it works, but when I move the form, it left "traces". The line is not moved.

Any workaround for this?
0
 
LVL 4

Expert Comment

by:delphi3
ID: 13430271
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
 
0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Have you ever had your Delphi form/application just hanging while waiting for data to load? This is the article to read if you want to learn some things about adding threads for data loading in the background. First, I'll setup a general applica…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
In this brief tutorial Pawel from AdRem Software explains how you can quickly find out which services are running on your network, or what are the IP addresses of servers responsible for each service. Software used is freeware NetCrunch Tools (https…
In this video, Percona Solution Engineer Dimitri Vanoverbeke discusses why you want to use at least three nodes in a database cluster. To discuss how Percona Consulting can help with your design and architecture needs for your database and infras…
Suggested Courses

764 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question