PC Plus SuperCD (UK) 2000 March/pcp161b.iso/handson/archive/Issue151/delphi/SaveForm3/movesave.pas

Pascal/Delphi Source File | 1999-01-18 | 7.9 KB | 311 lines

unit movesave;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    PopupMenu1: TPopupMenu;
    AlignLeft1: TMenuItem;
    AlignTop1: TMenuItem;
    AlignRight1: TMenuItem;
    AlignBottom1: TMenuItem;
    MakeSameSize1: TMenuItem;
    GroupBox1: TGroupBox;
    SaveBtn: TButton;
    LoadBtn: TButton;
    ShowCmpsBtn: TButton;
    procedure FormCreate(Sender: TObject);
    procedure AButtonMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure AButtonMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure AButtonClick(Sender: TObject);
    procedure AlignLeft1Click(Sender: TObject);
    procedure AlignTop1Click(Sender: TObject);
    procedure AlignRight1Click(Sender: TObject);
    procedure AlignBottom1Click(Sender: TObject);
    procedure MakeSameSize1Click(Sender: TObject);
    procedure SaveBtnClick(Sender: TObject);
    procedure LoadBtnClick(Sender: TObject);
    procedure ShowCmpsBtnClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    Xdiff  : integer;
    Ydiff  : integer;
    XRtMargin : integer;
    YBtmMargin : integer;
    TriggerBtn : TButton;
    procedure MoveBtn( btn : TButton; X, Y : integer );
    procedure SizeBtn( btn : TButton; X, Y : integer );
    procedure ZapComponents;
    function SaveForm( fname : string ) : boolean;
    function LoadForm( fname : string ) : boolean;
  end;

const
  ResizeZone = 10;{Allow resizing if pointer is 10 pixels from rt button corner}
  MinW = 70;      { Minimum possible Width and Height of button                }
  MinH = 20;
  TooSmall = 2;   { Stop resizing action if W or H is less than this           }

    { Define Cursors }
  NormalCursor = crDefault;
  MoveCursor = crDrag;
  SizeCursor = crSizeNWSE;

  SAVEFILE = 'MyFile.dwf';

type
    { Used to store the currently active Mouse Mode or action                  }
  MouseMode =(Moving,Sizing,LeftClicked,Nothing);

var
  Form1: TForm1;
  MsMode : MouseMode;

implementation

{$R *.DFM}

{ ===== }


procedure TForm1.ZapComponents;
var
   i : integer;
begin
   for i := 0 to ComponentCount - 1 do
   begin
     if TComponent(Components[0]) is TControl then
       TControl(Components[0]).Parent := nil;
     Form1.RemoveComponent(Components[0]);
   end;
end;


function TForm1.SaveForm( fname : string ) : boolean;
var
   fs : TFileStream;
begin
   result := true;
   fs := TFileStream.Create( fname, fmCreate );
   try
     try
       fs.WriteComponent( Form1 );
     except
       result := false;
     end;
   finally
     fs.Free;
   end;
end;

function TForm1.LoadForm( fname : string ) : boolean;
var
   fs : TFileStream;
begin
   result := true;
   fs := TFileStream.Create( fname, fmOpenRead );
   ZapComponents;
   try
     try
       fs.ReadComponent( Form1 );
     except
       result := false;
     end;
   finally
     fs.Free;
   end;
end;

{ ===== }

procedure TForm1.FormCreate(Sender: TObject);
begin
  MsMode := Nothing;
  TriggerBtn := Button1;
end;

procedure TForm1.AButtonMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
  { When mouse button is pressed take action as appropriate }
var
   btn : TButton;
begin
  btn := TButton(Sender);
   { If it was a Left-Button click }
  if Button = mbLeft then
  begin
    { If the click occured in bottom right corner, set Mode to Sizing }
     if ( X >= btn.Width-ResizeZone) and (Y >= btn.Height-ResizeZone) then
     begin
        MsMode := Sizing;
        Screen.Cursor := SizeCursor;
     end
     else  { else set Mode to LeftClicked }
        MsMode := LeftClicked;
           { Save X and Y coordinates at time of button click }
     Xdiff := X;
     Ydiff := Y;
           { Also save the size of the Right and Bottom margins from mouse     }
           { pointer to the edge of the button                                 }
     XRtMargin := btn.Width - X;
     YBtmMargin := btn.Height - Y;
  end
  else     { else it was a Right-Click. So remember which button was clicked!  }
      TriggerBtn := TButton(Sender);
end;

procedure TForm1.MoveBtn( btn : TButton; X, Y : integer  );
begin
   btn.Top := btn.Top + Y  - Ydiff;
   btn.Left := btn.Left + X - Xdiff;
   Screen.Cursor := MoveCursor;
end;


procedure TForm1.SizeBtn( btn : TButton; X, Y : integer  );
begin
   { if user tries to size beyond absolute minimum limits, stop Sizing     }
   if (X < TooSmall ) or (Y < TooSmall ) then
   begin
      MsMode := Nothing;
      Screen.Cursor := NormalCursor;
   end
   else { otherwise size button as pointer moves                            }
   begin
     if X >= MinW then
        btn.Width := X + XRtMargin;
     if Y >= MinH then
        btn.Height := Y + YBtmMargin;
   end;
end;

procedure TForm1.AButtonMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
{ When the mouse pointer moves over this button, take action according to
  the current value of MsMode.

  Val of MsMode     Action to Take
  * Sizing          * Resize button on mouse move
  * LeftClicked     * Set mode to Moving
  * Moving          * Move the button
  }
var
  btn : TButton;
begin
  btn := TButton(Sender);
  Caption := btn.name + ' X:' + IntToStr(X) + ' Y:' + IntToStr(Y);
  { --- SIZING --- }
  if MsMode = Sizing then
     SizeBtn( btn, X, Y )
  else
  begin
  { --- LEFTCLICKED --- }
  if MsMode = LeftClicked then
     MsMode := Moving;
  { --- MOVING --- }
  if (MsMode = Moving) then
      MoveBtn( btn, X, Y );
  end;
  // if MsMode = Nothing then { do nothing } ;
end;

procedure TForm1.AButtonClick(Sender: TObject);
begin
  if MsMode = LeftClicked then
     ShowMessage( 'You clicked: ' + TButton(Sender).name );
  MsMode := Nothing;
  Screen.Cursor := NormalCursor;
end;

procedure TForm1.AlignLeft1Click(Sender: TObject);
var
  i : integer;
begin
 for i := 0 to ComponentCount - 1 do
    if Components[i] is TButton then
       TButton(Components[i]).Left := TriggerBtn.Left;
end;

procedure TForm1.AlignTop1Click(Sender: TObject);
var
  i : integer;
begin
 for i := 0 to ComponentCount - 1 do
    if Components[i] is TButton then
       TButton(Components[i]).Top := TriggerBtn.Top;
end;

procedure TForm1.AlignRight1Click(Sender: TObject);
var
  i : integer;
  RightEdge : integer;
begin
 RightEdge := (TriggerBtn.Left + TriggerBtn.Width);
 for i := 0 to ComponentCount - 1 do
    if Components[i] is TButton then
       TButton(Components[i]).Left := RightEdge - TButton(Components[i]).Width;
end;

procedure TForm1.AlignBottom1Click(Sender: TObject);
var
  i : integer;
  BottomEdge : integer;
begin
 BottomEdge := (TriggerBtn.Top + TriggerBtn.Height);
 for i := 0 to ComponentCount - 1 do
    if Components[i] is TButton then
       TButton(Components[i]).Top := BottomEdge - TButton(Components[i]).Height;
end;


procedure TForm1.MakeSameSize1Click(Sender: TObject);
var
  i : integer;
begin
 for i := 0 to ComponentCount - 1 do
    if Components[i] is TButton then
       with TButton(Components[i]) do
       begin
          Width := TriggerBtn.Width;
          Height := TriggerBtn.Height;
       end;
end;

procedure TForm1.SaveBtnClick(Sender: TObject);
begin
   if not SaveForm(SAVEFILE) then
      ShowMessage( 'Error: Can''t save ' +  SAVEFILE );
end;

procedure TForm1.LoadBtnClick(Sender: TObject);
begin
   if not LoadForm(SAVEFILE) then
      ShowMessage( 'Error: Can''t load ' +  SAVEFILE );
end;

procedure TForm1.ShowCmpsBtnClick(Sender: TObject);
var
  i : integer;
  s : string;
begin
  s := '';
  for i := 0 to (ComponentCount-1) do
    s := s + Format('[%d] %s, ', [i, Components[i].name]);
    ShowMessage( s );
end;


end.