Re: OpenPictureDialog Problems

Sorry for being so vague. When I run it I get Acces Violation.

>Does it work when you assign the loaded bitmap to a TImage
>component on your form instead of to NewShape?

Yes It works with Tshape but not the component I am using TManyShape.
I am new to all this so please go easy on me.
Thanks.

This is the code I have so far.


var
Form1: TForm1;

implementation


const
RIGHT_BUTTON_UP = 0;
RIGHT_BUTTON_DOWN = 1;
{$R *.dfm}

procedure TForm1.MouseUpOnShape(Sender : TObject; Button:
TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
ColorDialog : TColorDialog;
begin
if Sender is TManyShape then
if (Sender as TManyShape).Tag = RIGHT_BUTTON_DOWN then
begin
ColorDialog := TColorDialog.Create(self);
try
if ColorDialog.Execute then
TManyShape(Sender).BackColor:= ColorDialog.Color;
TManyShape(Sender).outlineColor:= ColorDialog.Color;
finally
ColorDialog.free;
end;
(Sender as TManyShape).Tag := RIGHT_BUTTON_UP;
end
else
if FMovingShape then
begin
FMovingShape := FALSE;
(Sender as TManyShape).Left := (Sender as TManyShape).Left -
(FMouseDown.x - x);
(Sender as TManyShape).Top := (Sender as TManyShape).Top -
(FMouseDown.y - y);
end;
end;

procedure TForm1.MouseDownOnShape(Sender : TObject; Button:
TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Sender is TManyShape then
begin
if ssRight in Shift then
(Sender as TManyShape).Tag := RIGHT_BUTTON_DOWN
else
begin
(Sender as TManyShape).Tag := RIGHT_BUTTON_UP;
if ssLeft in Shift then
begin
FMouseDown.x := X;
FMouseDown.y := Y;
FMovingShape := TRUE;
end;
end;
end;
end;

procedure TForm1.MouseMoveOnShape(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
begin
if FMovingShape then
begin
(Sender as TManyShape).Left := (Sender as TManyShape).Left -
(FMouseDown.x
- x);
(Sender as TManyShape).Top := (Sender as TManyShape).Top -
(FMouseDown.y
- y);
end;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
var
NewShape : TManyShape;
begin
NewShape := TManyShape.Create(self);
NewShape.Left := 100;
NewShape.Top := 80;
NewShape.OnMouseDown := MouseDownOnShape;
NewShape.OnMouseMove := MouseMoveOnShape;
NewShape.OnMouseUp := MouseUpOnShape;
NewShape.Parent := Self;
Newshape.OutlineStyle:=psDot;
NewShape.Width:=95;
NewShape.Height:=95;
end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
var
NewShape : TManyShape;
begin
NewShape := TManyShape.Create(self);
Newshape.Shape:=gstDiamond;
NewShape.Left := 100;
NewShape.Top := 80;
NewShape.Height:=95;
Newshape.Width:=95;
NewShape.OnMouseDown := MouseDownOnShape;
NewShape.OnMouseMove := MouseMoveOnShape;
NewShape.OnMouseUp := MouseUpOnShape;
NewShape.Parent := Self;
Newshape.OutlineStyle:=psDot;

end;

procedure TForm1.SpeedButton3Click(Sender: TObject);
var
NewShape : TManyShape;
begin
NewShape := TManyShape.Create(self);
Newshape.Shape:=gstStar;
NewShape.Left := 100;
NewShape.Top := 80;
NewShape.Height:=108;
Newshape.Width:=108;
NewShape.OnMouseDown := MouseDownOnShape;
NewShape.OnMouseMove := MouseMoveOnShape;
NewShape.OnMouseUp := MouseUpOnShape;
NewShape.Parent := Self;
Newshape.OutlineStyle:=psDot;

end;

procedure TForm1.Button1Click(Sender: TObject);
var OpenPicDlg : TOpenPictureDialog;
Bitmap: TBitmap;
NewShape : TManyShape;
begin
Bitmap := TBitmap.Create;
OpenPicDlg := TOpenPictureDialog.Create(Self);
if OpenPicDlg.Execute then
begin
bitmap.LoadFromFile(OpenPicDlg.FileName);
Newshape.Image :=Bitmap;
end;
OpenPicDlg.Free;

end;

procedure TForm1.SpeedButton4Click(Sender: TObject);
var
NewShape : TManyShape;
begin
NewShape := TManyShape.Create(self);
Newshape.Shape:=gstTriangledown;
NewShape.Left := 100;
NewShape.Top := 100;
NewShape.Height:=48;
Newshape.Width:=96;
NewShape.OnMouseDown := MouseDownOnShape;
NewShape.OnMouseMove := MouseMoveOnShape;
NewShape.OnMouseUp := MouseUpOnShape;
NewShape.Parent := Self;
Newshape.OutlineStyle:=psDot;

end;

end.






On Fri, 22 Jul 2005 10:01:48 +0200, "Maarten Wiltink"
<maarten@xxxxxxxxxxxxxxxxxx> wrote:

><cybatech@xxxxxxxxxxxxx> wrote in message
>news:6cu0e1hd0q1nkt2ldj0d62ej1dt7uo404h@xxxxxxxxxx
>
>> Can some please tell me why this won't work?
>>
>> procedure TForm1.Button1Click(Sender: TObject);
>> var OpenPicDlg : TOpenPictureDialog;
>> Bitmap: TBitmap;
>> NewShape : TManyShape;
>> begin
>> Bitmap := TBitmap.Create;
>> OpenPicDlg := TOpenPictureDialog.Create(Self);
>> if OpenPicDlg.Execute then
>> begin
>> bitmap.LoadFromFile(OpenPicDlg.FileName);
>> Newshape.Image :=Bitmap;
>> end;
>> OpenPicDlg.Free;
>> end;
>
>One easy guess: no NewShape:=TManyShape.Create anywhere.
>
>Did you step through this code and see exactly where the
>error occurs? For that matter, what _is_ the error message,
>and why aren't you telling us?
>
>Does it work when you assign the loaded bitmap to a TImage
>component on your form instead of to NewShape?
>
>It's a good habit to _always_ start a try-finally after a
>Create and Free in the finally clause.
>
>Groetjes,
>Maarten Wiltink
>

.

Quantcast