flexlibs.pas

是一套创建矢量图形的VCL组件

/////////////////////////////////////////////////////////
//                                                     //
//    FlexGraphics library                             //
//    Copyright (c) 2002-2003, FlexGraphics software.  //
//                                                     //
//    Flex-libraries support                           //
//                                                     //
/////////////////////////////////////////////////////////

unit FlexLibs;

{$I FlexDefs.inc}

interface

uses
  Windows, Classes, Controls, SysUtils, Graphics,  
  FlexBase, FlexProps, FlexUtils;

type
  TFlexLibItem = class(TFlexControl)
  protected
   procedure CreateProperties; override;
   procedure ControlCreate; override;
  public
   function  CreateDragObject: TFlexDragObject;
  end;

  TFlexLibrary = class(TFlexCustomScheme)
  private
   FFilename: string;
   FModified: boolean;
   function  GetByName(const Name: string): TFlexLibItem;
   function  GetLibItem(Index: integer): TFlexLibItem;
  protected
   procedure CreateProperties; override;
   procedure ControlCreate; override;
  public
   function  New: TFlexLibItem;
   function  NewFromFlex(AFlex: TFlexPanel): TFlexLibItem;
   function  Add(AControl: TFlexControl): integer; override;
   procedure Delete(Index: integer); override;
   procedure SaveToFiler(Filer: TFlexFiler; const Indent: string); override;
   procedure LoadFromFiler(Filer: TFlexFiler); override;
   property  Controls[Index: integer]: TFlexLibItem read GetLibItem; default;
   property  ByName[const Name: string]: TFlexLibItem read GetByName;
   property  LibFilename: string read FFilename write FFilename;
   property  Modified: boolean read FModified write FModified;
  end;

  TFlexLibraries = class
  private
   FFlex: TFlexPanel;
   FOnChange: TNotifyEvent;
   function GetCount: integer;
   function GetItem(Index: integer): TFlexLibrary;
  protected
   procedure DoOnChange; virtual;
   property  Flex: TFlexPanel read FFlex;
  public
   constructor Create;
   destructor Destroy; override;
   function  New(const Filename: string): TFlexLibrary;
   function  IndexOf(ALibrary: TFlexLibrary): integer;
   procedure Remove(ALibrary: TFlexLibrary);
   function  SaveLibrary(ALibrary: TFlexLibrary): boolean;
   function  LoadLibrary(ALibrary: TFlexLibrary): boolean;
   property  Count: integer read GetCount;
   property  Items[Index: integer]: TFlexLibrary read GetItem; default;
   property  OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

var
  FlexLibraries: TFlexLibraries;

implementation

// TFlexLibItem //////////////////////////////////////////////////////////////

procedure TFlexLibItem.ControlCreate;
begin
 NonVisual := true;
 ShowHintProp.Value := True;
 if Assigned(Owner) then begin
  Name := Owner.GetDefaultNewName(Self, Parent);
  Owner.GenerateID(Self);
 end;
 //inherited;
 Visible := true;
 DoNotify(fnCreated);
end;

procedure TFlexLibItem.CreateProperties;
const HideSet: TPropStyle = [ psReadOnly, psDontStore, psNonVisual ];
begin
 inherited;
 LeftProp.Style := HideSet;
 TopProp.Style := HideSet;
 IdProp.Style := HideSet;
 ShowHintProp.Style := HideSet;
 LayerProp.Style := HideSet;
 ReferenceProp.Style := HideSet;
end;

function TFlexLibItem.CreateDragObject: TFlexDragObject;
begin
 Result := Owner.CreateDragObject(Self, True, False);
end;

// TFlexLibrary //////////////////////////////////////////////////////////////

procedure TFlexLibrary.ControlCreate;
begin
 NonVisual := true;
 ShowHintProp.Value := True;
 inherited;
end;

procedure TFlexLibrary.CreateProperties;
const HideSet: TPropStyle = [ psReadOnly, psDontStore, psNonVisual ];
begin
 inherited;
 ShowHintProp.Style := HideSet;
 IdProp.Style := HideSet;
 ReferenceProp.Style := HideSet;
end;
                
function TFlexLibrary.Add(AControl: TFlexControl): integer;
var PassRec: TPassControlRec;
begin
 Result := inherited Add(AControl);
 if Result >= 0 then begin
  FirstControl(AControl, PassRec);
  try
   while Assigned(AControl) do begin
    AControl.Reference := Nil;
    AControl := NextControl(PassRec);
   end;
  finally
   ClosePassRec(PassRec);
  end;
  FModified := true;
 end;
end;

procedure TFlexLibrary.Delete(Index: integer);
begin
 inherited;
 FModified := true;
end;

function TFlexLibrary.GetByName(const Name: string): TFlexLibItem;
begin
 Result := TFlexLibItem( inherited ByName[Name] );
end;

function TFlexLibrary.GetLibItem(Index: integer): TFlexLibItem;
begin
 Result := TFlexLibItem( inherited Controls[Index] );
end;

procedure TFlexLibrary.LoadFromFiler(Filer: TFlexFiler);
var s: string;
    i: integer;
begin
 s := Filer.LoadStr;
 if not StrBeginsFrom(s, fcLibrary) then
  raise Exception.Create('Data format error');
 i := Pos(' ', s);
 if i > 0 then
  Name := Trim(copy(s, i+1, MaxInt));
 inherited;
end;

function TFlexLibrary.New: TFlexLibItem;
begin
 Result := TFlexLibItem.Create(Owner, Self, Nil);
end;

function TFlexLibrary.NewFromFlex(AFlex: TFlexPanel): TFlexLibItem;
var MS: TMemoryStream;
    Filer: TFlexFiler;
    s: string;
    LoadOrigin: TPoint;
    Control: TFlexControl;
begin
 Result := New;
 if not Assigned(Result) then exit;
 try
  MS := Nil;
  Filer := Nil;
  try
   MS := TMemoryStream.Create;
   Filer := TFlexFiler.Create(MS);
   with AFlex.SelectedRange do begin
    LoadOrigin.X := -Left;
    LoadOrigin.Y := -Top;
    Result.Width := Right - Left;
    Result.Height := Bottom - Top; 
   end;
   AFlex.SaveToFiler(Filer, True);
   Filer.Rewind;
   s := Filer.LoadStr;
   if not StrBeginsFrom(s, fcClipboard) then
    raise Exception.Create('Data format error');
   while Filer.LoadStrCheck(s) do begin
    if StrBeginsFrom(s, fcEnd) then
     break
    else
    if StrBeginsFrom(s, fcObject) then begin
     Control := Owner.LoadFlexControl(Filer, Result, s);
     if Assigned(Control) then begin
      Control.Left := Control.Left + LoadOrigin.X;
      Control.Top  := Control.Top  + LoadOrigin.Y;
     end;
    end else
     Filer.LoadSkipToEnd;
   end;
  finally
   Filer.Free;
   MS.Free;
  end;
 except
  Result.Free;
  raise;
 end;
end;

procedure TFlexLibrary.SaveToFiler(Filer: TFlexFiler; const Indent: string);
var i: integer;
begin
 Filer.SaveStr(fcLibrary + ' ' + Name);
 Props.SaveToFiler(Filer, IndentStep);
 for i:=0 to Count-1 do
  Controls[i].SaveToFiler(Filer, IndentStep);
 Filer.SaveStr(fcEnd);
end;

// TFlexLibraries ////////////////////////////////////////////////////////////

constructor TFlexLibraries.Create;
begin
 inherited;
 FFlex := TFlexPanel.Create(Nil);
 FFlex.EmptyDocument;
 FFlex.ShowDocFrame := False;
end;

destructor TFlexLibraries.Destroy;
begin
 FFlex.Free;
 inherited;
end;

procedure TFlexLibraries.DoOnChange;
begin
 if Assigned(FOnChange) then FOnChange(Self);
end;

function TFlexLibraries.GetCount: integer;
begin
 Result := FFlex.Schemes.Count;
end;

function TFlexLibraries.GetItem(Index: integer): TFlexLibrary;
begin
 Result := TFlexLibrary(FFlex.Schemes[Index]);
end;

function TFlexLibraries.New(const Filename: string): TFlexLibrary;
begin
 Result := TFlexLibrary.Create(FFlex, FFlex.Schemes, Nil);
 if Filename <> '' then begin
  Result.LibFilename := Filename;
  if FileExists(Filename) then
   try
    LoadLibrary(Result);
   except
    Result.Free;
    raise;
   end
  else
   try
    SaveLibrary(Result);
   except
    Result.Free;
    raise;
   end;
 end;
 DoOnChange;
end;

procedure TFlexLibraries.Remove(ALibrary: TFlexLibrary);
begin
 FFlex.Schemes.Remove(ALibrary);
 DoOnChange;
end;

function TFlexLibraries.IndexOf(ALibrary: TFlexLibrary): integer;
begin
 Result := FFlex.Schemes.IndexOf(ALibrary);
end;

function TFlexLibraries.LoadLibrary(ALibrary: TFlexLibrary): boolean;
var FS: TFileStream;
    Filer: TFlexFiler;
begin
 Result := False;
 if not Assigned(ALibrary) or (FFlex.Schemes.IndexOf(ALibrary) < 0) then exit;
 FS := Nil;
 Filer := Nil;
 try
  FS := TFileStream.Create(ALibrary.LibFilename,
    fmOpenRead or fmShareDenyWrite);
  Filer := TFlexFiler.Create(FS);
  ALibrary.LoadFromFiler(Filer);
  ALibrary.Modified := False;
  Result := true;
 finally
  Filer.Free;
  FS.Free;
 end;
end;

function TFlexLibraries.SaveLibrary(ALibrary: TFlexLibrary): boolean;
var FS: TFileStream;
    Filer: TFlexFiler;
begin
 Result := False;
 if not Assigned(ALibrary) or (FFlex.Schemes.IndexOf(ALibrary) < 0) then exit;
 FS := Nil;
 Filer := Nil;
 try
  FS := TFileStream.Create(ALibrary.LibFilename, fmCreate);
  Filer := TFlexFiler.Create(FS);
  ALibrary.SaveToFiler(Filer, '');
  ALibrary.Modified := False;
  Result := true;
 finally
  Filer.Free;
  FS.Free;
 end;
end;

///////////////////////////////////////////////////////////////////////////////

procedure RegisterControls;
begin
 RegisterFlexControl(TFlexLibItem);
end;

initialization
  RegisterControls;
  FlexLibraries := TFlexLibraries.Create;

finalization
  FlexLibraries.Free;
  FlexLibraries := Nil;

end.