Re: OpenPictureDialog Problems

This is all the code. I can get the Image to work on a single shape
but not when using Newshape.


unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
procedure MouseDownOnShape(Sender : TObject;Button:
TMouseButton;Shift: TShiftState;
X, Y: Integer);
procedure MouseMoveOnShape(sender : TObject;Shift: TShiftState;
X, Y: Integer);
procedure MouseUpOnShape(Sender : TObject;Button:
TMouseButton;Shift: TShiftState;
X, Y: Integer);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }

FMouseDown : TPoint;
FMovingShape : Boolean;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}
const
RIGHT_BUTTON_UP = 0;
RIGHT_BUTTON_DOWN = 1;
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.Button1Click(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 Mon, 25 Jul 2005 07:03:34 GMT, cybatech@xxxxxxxxxxxxx wrote:

>
>This is the code I am trying. It works fine with Tshape!
>The component is here
>http://downloads.delphi32.com/740/1221/manysh.zip
>
>procedure TForm1.BitBtn1Click(Sender: TObject);
>var OpenPicDlg : TOpenPictureDialog;
> Bitmap: TBitmap;
>
>begin
> Bitmap := TBitmap.Create;
> OpenPicDlg := TOpenPictureDialog.Create(Self);
> if OpenPicDlg.Execute then
> begin
> bitmap.LoadFromFile(OpenPicDlg.FileName);
> manyshape1.Image := Bitmap;
> end;
> OpenPicDlg.Free;
> end;
>
>
>
>
>
>
>On Mon, 25 Jul 2005 08:59:54 +1000, "Henry Bartlett"
><hambar@xxxxxxxxxxxxxxxxxxxxxxxxx> wrote:
>
>><cybatech@xxxxxxxxxxxxx> wrote in message
>>news:20r5e114gr4i03ikisi76ungv52tivs5r9@xxxxxxxxxx
>>> Thanks Guys but I'm still getting accessvoilation.
>>
>>Show us the full code you are currently using for the method in which
>>you are getting the AV
>>
>>---
>>Henry Bartlett
>>Delphi Links Page:
>>( http://www.hotkey.net.au/~hambar/habit/delflink.htm )
>>
>>
>>
>>
>>
>>

.

Quantcast