Watch, Follow, &
Connect with Us

For forums, blogs and more please visit our
Developer Tools Community.


Welcome, Guest
Guest Settings
Help

Thread: VCL FOR PC: How not to be filled with color for Rectangle?


This question is not answered. Helpful answers available: 2. Correct answers available: 1.


Permlink Replies: 9 - Last Post: Aug 3, 2015 10:01 AM Last Post By: John Treder
hots wally

Posts: 53
Registered: 6/14/14
VCL FOR PC: How not to be filled with color for Rectangle?  
Click to report abuse...   Click to reply to this thread Reply
  Posted: Aug 2, 2015 1:58 AM
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
Canvas.Pen.Width := 4;
Canvas.Pen.Color := clRed;
//Canvas.Brush.Color := clwindow;
Canvas.Rectangle(pt.X, pt.Y, Endpt.X, Endpt.Y);
...
end;
Rudy Velthuis (...


Posts: 7,731
Registered: 9/22/99
Re: VCL FOR PC: How not to be filled with color for Rectangle?  
Click to report abuse...   Click to reply to this thread Reply
  Posted: Aug 2, 2015 2:18 AM   in response to: hots wally in response to: hots wally
hots wally wrote:

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
begin
Canvas.Pen.Width := 4;
Canvas.Pen.Color := clRed;

Canvas.Brush.Style := bsClear;

//Canvas.Brush.Color := clwindow;
Canvas.Rectangle(pt.X, pt.Y, Endpt.X, Endpt.Y);
...
end;

Brushes are usually bsSolid. To turn them off, make them bsClear.
--
Rudy Velthuis http://www.rvelthuis.de

"Intellectuals solve problems; geniuses prevent them."
-- Albert Einstein
hots wally

Posts: 53
Registered: 6/14/14
Re: VCL FOR PC: How not to be filled with color for Rectangle?  
Click to report abuse...   Click to reply to this thread Reply
  Posted: Aug 2, 2015 2:55 AM   in response to: hots wally in response to: hots wally
hots wally wrote:
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
Canvas.Pen.Width := 4;
Canvas.Pen.Color := clRed;
//Canvas.Brush.Color := clwindow;
Canvas.Rectangle(pt.X, pt.Y, Endpt.X, Endpt.Y);
...
end;

BUT in MouseMove event, the rectangle be filled with border color
Rudy Velthuis (...


Posts: 7,731
Registered: 9/22/99
Re: VCL FOR PC: How not to be filled with color for Rectangle?  
Click to report abuse...   Click to reply to this thread Reply
  Posted: Aug 2, 2015 3:26 AM   in response to: hots wally in response to: hots wally
hots wally wrote:

hots wally wrote:
procedure TForm1.Image1MouseMove(Sender: TObject; Shift:
TShiftState; X, Y: Integer);
begin
Canvas.Pen.Width := 4;
Canvas.Pen.Color := clRed;
//Canvas.Brush.Color := clwindow;
Canvas.Rectangle(pt.X, pt.Y, Endpt.X, Endpt.Y);
...
end;

BUT in MouseMove event, the rectangle be filled with border color

Which canvas are you using?

--
Rudy Velthuis http://www.rvelthuis.de

"The corporation is a true Frankenstein's monster, an
artificial person run amok, responsible only to its own
soulless self."
-- William Dugger
hots wally

Posts: 53
Registered: 6/14/14
Re: VCL FOR PC: How not to be filled with color for Rectangle?  
Click to report abuse...   Click to reply to this thread Reply
  Posted: Aug 2, 2015 3:42 AM   in response to: hots wally in response to: hots wally
hots wally wrote:
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
Canvas.Pen.Width := 4;
Canvas.Pen.Color := clRed;
//Canvas.Brush.Color := clwindow;
Canvas.Rectangle(pt.X, pt.Y, Endpt.X, Endpt.Y);
...
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
H,W:integer;
begin
if (Dragging_) then
try
Canvas.Pen.Width := 2;
Canvas.Pen.Color := clRed;
Canvas.Brush.Style := bsClear;
Canvas.Rectangle(pt.X-2, pt.Y-2, Endpt.X+2, Endpt.Y+2);
finally
Endpt:= Point(X, Y);
H:= abs(pt.y - Endpt.y);
W:= abs(pt.x - Endpt.x);
Canvas.DrawFocusRect(rect_);
if (pt.x < Endpt.x) and(pt.y < Endpt.y) then
begin
rect_.Left:= pt.x;
rect_.top:= pt.y;
end
else if (pt.x < Endpt.x) and(pt.y > Endpt.y) then
begin
rect_.Left:= pt.x;
rect_.top:= Endpt.y;
end
else if(pt.x > Endpt.x) and(pt.y > Endpt.y) then
begin
rect_.Left:= Endpt.x;
rect_.top:= Endpt.y;
end
else if(pt.x > Endpt.x) and(pt.y < Endpt.y) then
begin
rect_.Left:= Endpt.x;
rect_.top:= pt.y;
end;
rect_.right:= rect_.left + W;
rect_.bottom:= rect_.top + H;
Canvas.DrawFocusRect(rect_);
end;
end;

Peter Below

Posts: 1,227
Registered: 12/16/99
Re: VCL FOR PC: How not to be filled with color for Rectangle?  
Click to report abuse...   Click to reply to this thread Reply
  Posted: Aug 2, 2015 6:05 AM   in response to: hots wally in response to: hots wally
hots wally wrote:

hots wally wrote:
procedure TForm1.Image1MouseMove(Sender: TObject; Shift:
TShiftState; X, Y: Integer);
begin
Canvas.Pen.Width := 4;
Canvas.Pen.Color := clRed;
//Canvas.Brush.Color := clwindow;
Canvas.Rectangle(pt.X, pt.Y, Endpt.X, Endpt.Y);
...
end;

You are using the form's canvas here, not the one of the image1!

--
Peter Below (TeamB)

hots wally

Posts: 53
Registered: 6/14/14
Re: VCL FOR PC: How not to be filled with color for Rectangle?  
Click to report abuse...   Click to reply to this thread Reply
  Posted: Aug 2, 2015 2:58 PM   in response to: Peter Below in response to: Peter Below
Peter Below wrote:
hots wally wrote:

hots wally wrote:
procedure TForm1.Image1MouseMove(Sender: TObject; Shift:
TShiftState; X, Y: Integer);
begin
Canvas.Pen.Width := 4;
Canvas.Pen.Color := clRed;
//Canvas.Brush.Color := clwindow;
Canvas.Rectangle(pt.X, pt.Y, Endpt.X, Endpt.Y);
...
end;

You are using the form's canvas here, not the one of the image1!

--
Peter Below (TeamB)

IS Image1, not Form1.
The whole code as below(pls help to improve it, thanks a lot)

unit Unit1;

interface

uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,Vcl.ExtCtrls,Jpeg,Clipbrd;

type
TForm1 = class(TForm)
Button1: TButton;
Image1: TImage;
procedure Button1Click(Sender: TObject);
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);

private
{ Private declarations }
public
{ Public declarations }
procedure SnapScreen;
end;

var
Form1: TForm1;
pt,Endpt : TPoint;
rect_: TRect;
Dragging_ : boolean;
bmp: TBitMap;
foldx,foldy: integer;

implementation

{$R *.dfm}

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Dragging_:= true;
pt:= Point(X, Y);
Endpt:= pt;
rect_.left:= pt.x;
rect_.top:= pt.y;
rect_.right:= pt.x;
rect_.bottom:= pt.y;
Canvas.DrawFocusRect(rect_);
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
H,W:integer;
begin
if (Dragging_) then
begin
Endpt:= Point(X, Y);
H:= abs(pt.y - Endpt.y);
W:= abs(pt.x - Endpt.x);
Canvas.DrawFocusRect(rect_);
if (pt.x < Endpt.x) and(pt.y < Endpt.y) then
begin
rect_.Left:= pt.x;
rect_.top:= pt.y;
end
else if (pt.x < Endpt.x) and(pt.y > Endpt.y) then
begin
rect_.Left:= pt.x;
rect_.top:= Endpt.y;
end
else if(pt.x > Endpt.x) and(pt.y > Endpt.y) then
begin
rect_.Left:= Endpt.x;
rect_.top:= Endpt.y;
end
else if(pt.x > Endpt.x) and(pt.y < Endpt.y) then
begin
rect_.Left:= Endpt.x;
rect_.top:= pt.y;
end;
rect_.right:= rect_.left + W;
rect_.bottom:= rect_.top + H;
Canvas.DrawFocusRect(rect_);
end;
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
bmp: TBitMap;
MyRect: TRect;
begin
if (Dragging_) then
begin
Dragging_:= false;
Endpt:= Point(X, Y);

Canvas.Pen.Width := 2;
Canvas.Pen.Color := clRed;
Canvas.Brush.Style := bsClear;
Canvas.Rectangle(pt.X-2, pt.Y-2, Endpt.X+2, Endpt.Y+2);

Canvas.DrawFocusRect(rect_);
bmp:= TBitMap.Create;
bmp.Width:= Rect_.Right - Rect_.Left;
bmp.Height:= Rect_.Bottom - Rect_.Top;
MyRect:= Rect(0, 0, bmp.Width, bmp.Height);
bmp.Canvas.CopyRect(MyRect, Canvas, Rect_);
ClipBoard.Assign(bmp);
end;
Self.WindowState := wsMinimized;
Button1.Visible:=True;
end;

procedure TForm1.SnapScreen;
var
bmpScreen : TBitmap;
ScreenCanvas : TCanvas;
ScrDC : HDC;
begin
bmpScreen := TBitmap.Create;
ScreenCanvas := TCanvas.Create;
try
bmpScreen.Width := Screen.Width;
bmpScreen.Height := Screen.Height;
ScrDC := GetWindowDC(0);
ScreenCanvas.Handle := scrDC;
bmpScreen.Canvas.CopyRect(Rect(0,0,Screen.Width,Screen.Height)
,ScreenCanvas,Rect(0,0,Screen.Width,Screen.Height));
ReleaseDC(0,ScrDC);
Image1.Left:=0; Image1.Top:=0;
Image1.Picture:=TPicture(bmpScreen);
finally
bmpScreen.Free;
ScreenCanvas.Free;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
try
Button1.Visible:=False;
Self.WindowState := wsMinimized;
Sleep(100);
SnapScreen;
Self.WindowState := wsMaximized;
finally
end;

end;

end.

John Treder

Posts: 349
Registered: 8/2/02
Re: VCL FOR PC: How not to be filled with color for Rectangle?  
Click to report abuse...   Click to reply to this thread Reply
  Posted: Aug 2, 2015 7:43 PM   in response to: hots wally in response to: hots wally
hots wally wrote:


IS Image1, not Form1.
um, No, sorry! My notes interleaved below.
I'll interleave my notes below, indented, and I'll delete porttions of your post that I don't think are important.
Maybe I'll miss something; I often do!

The whole code as below(pls help to improve it, thanks a lot)

unit Unit1;

interface

var
Form1: TForm1;
pt,Endpt : TPoint;
rect_: TRect;
Dragging_ : boolean;
bmp: TBitMap;
foldx,foldy: integer;
There is no Canvas variable here.

implementation

{$R *.dfm}

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Dragging_:= true;
pt:= Point(X, Y);
Endpt:= pt;
rect_.left:= pt.x;
rect_.top:= pt.y;
rect_.right:= pt.x;
rect_.bottom:= pt.y;
Canvas.DrawFocusRect(rect_);
This is drawn on the Form's canvas. It draws only a single point at the TopLeft of rect_ .
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
H,W:integer;
begin
if (Dragging_) then
begin
Endpt:= Point(X, Y);
H:= abs(pt.y - Endpt.y);
W:= abs(pt.x - Endpt.x);
Canvas.DrawFocusRect(rect_);
This is drawn on the Form's canvas. It draws the same thing as in MouseDown.

if (pt.x < Endpt.x) and(pt.y < Endpt.y) then
begin
rect_.Left:= pt.x;
rect_.top:= pt.y;
end
else if (pt.x < Endpt.x) and(pt.y > Endpt.y) then
begin
rect_.Left:= pt.x;
rect_.top:= Endpt.y;
end
else if(pt.x > Endpt.x) and(pt.y > Endpt.y) then
begin
rect_.Left:= Endpt.x;
rect_.top:= Endpt.y;
end
else if(pt.x > Endpt.x) and(pt.y < Endpt.y) then
begin
rect_.Left:= Endpt.x;
rect_.top:= pt.y;
end;
rect_.right:= rect_.left + W;
rect_.bottom:= rect_.top + H;
Canvas.DrawFocusRect(rect_);
This draws a rectangle on the Form's canvas. Because the X, Y coordinates are relative to the form, it looks like it's doing what you want.

end;
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
bmp: TBitMap;
MyRect: TRect;
begin
if (Dragging_) then
begin
Dragging_:= false;
Endpt:= Point(X, Y);

Canvas.Pen.Width := 2;
Canvas.Pen.Color := clRed;
Canvas.Brush.Style := bsClear;
Canvas.Rectangle(pt.X-2, pt.Y-2, Endpt.X+2, Endpt.Y+2);

Canvas.DrawFocusRect(rect_);
Once again, drawn on the form's Canvas. You haven't used Image1's Canvas yet.

bmp:= TBitMap.Create;
bmp.Width:= Rect_.Right - Rect_.Left;
bmp.Height:= Rect_.Bottom - Rect_.Top;
MyRect:= Rect(0, 0, bmp.Width, bmp.Height);
bmp.Canvas.CopyRect(MyRect, Canvas, Rect_);
ClipBoard.Assign(bmp);
end;
Self.WindowState := wsMinimized;
Button1.Visible:=True;
end;

procedure TForm1.SnapScreen;
var
bmpScreen : TBitmap;
ScreenCanvas : TCanvas;
ScrDC : HDC;
begin
bmpScreen := TBitmap.Create;
ScreenCanvas := TCanvas.Create;
try
bmpScreen.Width := Screen.Width;
bmpScreen.Height := Screen.Height;
ScrDC := GetWindowDC(0);
ScreenCanvas.Handle := scrDC;
bmpScreen.Canvas.CopyRect(Rect(0,0,Screen.Width,Screen.Height)
,ScreenCanvas,Rect(0,0,Screen.Width,Screen.Height));
Here, you have copied the entire screen window rectangle to bmpScreen. bmpScreen is local to this procedure and isn't visible anywhere else.

ReleaseDC(0,ScrDC);
Image1.Left:=0; Image1.Top:=0;
Image1.Picture:=TPicture(bmpScreen);
finally
bmpScreen.Free;
ScreenCanvas.Free;
end;
end;

I hope this doesn't confuse you too much.
I think what you're trying to do is copy the entire window (monitor, laptop screen, etc) to Image1. Am I guessing right?

--
Tred
Rudy Velthuis (...


Posts: 7,731
Registered: 9/22/99
Re: VCL FOR PC: How not to be filled with color for Rectangle?  
Click to report abuse...   Click to reply to this thread Reply
  Posted: Aug 2, 2015 11:07 PM   in response to: hots wally in response to: hots wally
hots wally wrote:

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
bmp: TBitMap;
MyRect: TRect;
begin
if (Dragging_) then
begin
Dragging_:= false;
Endpt:= Point(X, Y);

Canvas.Pen.Width := 2;
Canvas.Pen.Color := clRed;
Canvas.Brush.Style := bsClear;
Canvas.Rectangle(pt.X-2, pt.Y-2, Endpt.X+2, Endpt.Y+2);

And again, you are using the form's canvas here.

You should only use the Form's canvas in the Paint method. In the rest
of the routines, you should only invalidate the rectangle to be
re-drawn (or the entire component).

--
Rudy Velthuis http://www.rvelthuis.de

"Perfection is achieved, not when there is nothing more to add,
but when there is nothing left to take away."
-- Antoine de Saint Exupéry

John Treder

Posts: 349
Registered: 8/2/02
Re: VCL FOR PC: How not to be filled with color for Rectangle?  
Click to report abuse...   Click to reply to this thread Reply
  Posted: Aug 3, 2015 10:01 AM   in response to: hots wally in response to: hots wally
hots wally wrote:


IS Image1, not Form1.
um, No, sorry! My notes interleaved below.
I'll interleave my notes below, indented, and I'll delete porttions of your post that I don't think are important.
Maybe I'll miss something; I often do!

The whole code as below(pls help to improve it, thanks a lot)

unit Unit1;

interface

var
Form1: TForm1;
pt,Endpt : TPoint;
rect_: TRect;
Dragging_ : boolean;
bmp: TBitMap;
foldx,foldy: integer;
There is no Canvas variable here.

implementation

{$R *.dfm}

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Dragging_:= true;
pt:= Point(X, Y);
Endpt:= pt;
rect_.left:= pt.x;
rect_.top:= pt.y;
rect_.right:= pt.x;
rect_.bottom:= pt.y;
Canvas.DrawFocusRect(rect_);
This is drawn on the Form's canvas. It draws only a single point at the TopLeft of rect_ .
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
H,W:integer;
begin
if (Dragging_) then
begin
Endpt:= Point(X, Y);
H:= abs(pt.y - Endpt.y);
W:= abs(pt.x - Endpt.x);
Canvas.DrawFocusRect(rect_);
This is drawn on the Form's canvas. It draws the same thing as in MouseDown.

if (pt.x < Endpt.x) and(pt.y < Endpt.y) then
begin
rect_.Left:= pt.x;
rect_.top:= pt.y;
end
else if (pt.x < Endpt.x) and(pt.y > Endpt.y) then
begin
rect_.Left:= pt.x;
rect_.top:= Endpt.y;
end
else if(pt.x > Endpt.x) and(pt.y > Endpt.y) then
begin
rect_.Left:= Endpt.x;
rect_.top:= Endpt.y;
end
else if(pt.x > Endpt.x) and(pt.y < Endpt.y) then
begin
rect_.Left:= Endpt.x;
rect_.top:= pt.y;
end;
rect_.right:= rect_.left + W;
rect_.bottom:= rect_.top + H;
Canvas.DrawFocusRect(rect_);
This draws a rectangle on the Form's canvas. Because the X, Y coordinates are relative to the form, it looks like it's doing what you want.

end;
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
bmp: TBitMap;
MyRect: TRect;
begin
if (Dragging_) then
begin
Dragging_:= false;
Endpt:= Point(X, Y);

Canvas.Pen.Width := 2;
Canvas.Pen.Color := clRed;
Canvas.Brush.Style := bsClear;
Canvas.Rectangle(pt.X-2, pt.Y-2, Endpt.X+2, Endpt.Y+2);

Canvas.DrawFocusRect(rect_);
Once again, drawn on the form's Canvas. You haven't used Image1's Canvas yet.

bmp:= TBitMap.Create;
bmp.Width:= Rect_.Right - Rect_.Left;
bmp.Height:= Rect_.Bottom - Rect_.Top;
MyRect:= Rect(0, 0, bmp.Width, bmp.Height);
bmp.Canvas.CopyRect(MyRect, Canvas, Rect_);
ClipBoard.Assign(bmp);
end;
Self.WindowState := wsMinimized;
Button1.Visible:=True;
end;

procedure TForm1.SnapScreen;
var
bmpScreen : TBitmap;
ScreenCanvas : TCanvas;
ScrDC : HDC;
begin
bmpScreen := TBitmap.Create;
ScreenCanvas := TCanvas.Create;
try
bmpScreen.Width := Screen.Width;
bmpScreen.Height := Screen.Height;
ScrDC := GetWindowDC(0);
ScreenCanvas.Handle := scrDC;
bmpScreen.Canvas.CopyRect(Rect(0,0,Screen.Width,Screen.Height)
,ScreenCanvas,Rect(0,0,Screen.Width,Screen.Height));
Here, you have copied the entire screen window rectangle to bmpScreen. bmpScreen is local to this procedure and isn't visible anywhere else.

ReleaseDC(0,ScrDC);
Image1.Left:=0; Image1.Top:=0;
Image1.Picture:=TPicture(bmpScreen);
finally
bmpScreen.Free;
ScreenCanvas.Free;
end;
end;

I hope this doesn't confuse you too much.
I think what you're trying to do is copy the entire window (monitor, laptop screen, etc) to Image1. Am I guessing right?

--
Tred
Legend
Helpful Answer (5 pts)
Correct Answer (10 pts)

Server Response from: ETNAJIVE02