Re: OpenPictureDialog Problems

The basic error is not setting TManyShape.SurfaceType to stBrushImage.
The TManyShape.Image gets painted _only_ when SurfaceType is set to
stBrushImage. The paint is done in FillWithBitmap called from all the
Paintwhatevershape methods.

I have emailed an example to cybat, of which the creation of manyshape
and mouse events are as follows. I have not included any checks for
Sender being a TManyShape. As the mouse events are allocated _only_ to
a TManyShape, I wonder at their necessity. Note that TManyShape tiles
the bitmap on the shape. The source code would need changing to centre
a smaller bitmap.

procedure TForm1.CreateShape(AType : TGPShapeType; ABounds :
TBoundsRect;
AColor : TColor);
begin
With TManyShape.Create(Self) do begin
Parent := Self; // should be first assignment after creation
Shape := AType;
with ABounds do
SetBounds(ALeft, ATop, AWidth, AHeight); // SetBounds does all in
one line
BackColor := AColor;
ForeColor := AColor;
{allocate event handlers}
OnMouseDown := ManyShapeMouseDown;
OnmouseMove := ManyShapeMouseMove;
OnMouseUp := ManyShapeMouseUp;
end;
end;

procedure TForm1.ManyShapeMouseDown(Sender: TObject; Button:
TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
Shape : TManyShape;
BM : TBitmap;
Msg : string;
begin
Shape := TManyShape(Sender); // allocate reference
if (Button = mbLeft) then begin
{left mouse button ...}
if (ssShift in Shift) then begin // set a shape color
{... and shift key}
Shape.Tag := 0; // prevent dragging
with ColorDialog1 do begin
Color := Shape.ForeColor;
if Execute then begin
Shape.ForeColor := Color;
Shape.BackColor := Color;
end; {if Execute}
end; {with ColorDialog1}
end {if (Shift = ssShift)}
else
if (ssCtrl in Shift) then begin // set a bitmap to tile on the
shape
Shape.Tag := 0;
with OpenPictureDialog1 do begin
InitialDir := ExtractFileDir(ParamStr(0));
Filter := 'Bitmap files (*.bmp)|*.bmp';
if Execute then begin
BM := TBitMap.Create;
BM.LoadFromFile(FileName);
Shape.SurfaceType := stBrushImage; // << important
Shape.Image := BM;
BM.Free;
end; {if Execute}
end; {with OpenPictureDialog1}
end {if (ssCtrl in Shift)}
else
{... no shift key} // Start of a shape dragging
Shape.Tag := MakeLong(X, Y);
{end; if (Shift = ssShift) else}
end; {if (Button = mbLeft)}
if (Button = mbRight) then begin // delete a shape
{right mouse to delete shape}
Msg := 'Are you sure you want to delete this shape ?';
{user confirmation ...}
if (Application.MessageBox(PChar(Msg), 'Delete a Shape',
MB_ICONWARNING or MB_APPLMODAL or MB_YESNO or MB_DEFBUTTON2) =
IDYES) then
Shape.Free;
end; {if (Button = mbRight)}
end;

procedure TForm1.ManyShapeMouseMove(Sender: TObject; Shift:
TShiftState;
X, Y: Integer);
var
Shape : TManyShape;
begin
Shape := TManyShape(Sender);
with Shape do // Tag == 0 is used as a flag to prevent dragging
unless after mouse-down
if (Tag > 0) and (Shift = [ssLeft]) then begin
Left := Left + X - LoWord(Tag);
Top := Top + Y - HiWord(Tag);
end;
{end; with Shape}
end;

procedure TForm1.ManyShapeMouseUp(Sender: TObject; Button:
TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
TManyShape(Sender).Tag := 0;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
i : integer;
begin
{free all TManyControls whose parent is Self}
for i := ControlCount - 1 downto 0 do // note reverse count
if (Controls[i] is TManyShape) then
Controls[i].Free;
{end; for i := 0 to ControlCount - 1}
end;

Alan Lloyd

.

Quantcast