dlib.pas

KSDev.BlockEngine.v3.03.rar 界面控件

unit dlib;

{$I be_define.inc}

interface

uses Windows, Classes, Controls, Contnrs, Graphics, SysUtils, GdipObj,
  Gdipapi, GdipUtil, ddoc, deditor, ComCtrls;

type

  TBlockDrag = class(TDragObject)
  private
    FBlock: Block;
  public
    constructor Create(ABlock: Block);
    property DragBlock: Block read FBlock write FBlock;
  end;

  TBlockLibrary = class(TListView)
  private
    FImages: TImageList;
    FEditor: TBlockEditor;
    FLibFileName: string;
    FDragging: boolean;
    FDoc: BlockDocument;
    FUpdating: boolean;
    FBlockDrag: TBlockDrag;
    procedure SetEditor(const Value: TBlockEditor);
    procedure SetLibFileName(const Value: string);
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure Loaded; override;
    procedure DoEndDrag(Target: TObject; X, Y: Integer); override;
    procedure DoStartDrag(var DragObject: TDragObject); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure LoadLib(AFileName: string);
    procedure UpdateBlocks; virtual;
  published
    property LibFileName: string read FLibFileName write SetLibFileName;
    property Editor: TBlockEditor read FEditor write SetEditor;
  end;

  TClassBlockLibrary = class(TBlockLibrary)
  private
    FBlocks: TStrings;
    procedure SetBlocks(const Value: TStrings);
  protected
    procedure Loaded; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure UpdateBlocks; override;
  published
    property Blocks: TStrings read FBlocks write SetBlocks;
  end;

implementation {===============================================================}

uses dgallery;

type

  THackBlock = class(Block);

{ TBlockDrag }

constructor TBlockDrag.Create(ABlock: Block);
begin
  inherited Create;
  FBlock := ABlock;
end;

{ TBlockLibrary }

constructor TBlockLibrary.Create(AOwner: TComponent);
begin
  inherited;
  FImages := TImageList.Create(nil);
  FImages.Width := 48;
  FImages.Height := 48;
  LargeImages := FImages;
  ViewStyle := vsIcon;
  DragMode := dmAutomatic;
  FBlockDrag := TBlockDrag.Create(nil);
end;

destructor TBlockLibrary.Destroy;
begin
  LargeImages := nil;
  FImages.Free;
  if FDoc <> nil then FDoc.Free;
  FBlockDrag.Free;
  inherited;
end;

procedure TBlockLibrary.DoEndDrag(Target: TObject; X, Y: Integer);
begin
  inherited;
  FDragging := true;
end;

procedure TBlockLibrary.DoStartDrag(var DragObject: TDragObject);
var
  S: Block;
begin
  inherited;
  if Editor = nil then Exit;

  FDragging := false;
  S := BlockClass(Block(Selected.Data).ClassType).Create(Editor.Document);
  S.CopyFrom(Block(Selected.Data));
  FBlockDrag.FBlock := S;
  DragObject := FBlockDrag;
end;

procedure TBlockLibrary.Loaded;
begin
  inherited;
  if FLibFileName <> '' then
    if not (csDesigning in ComponentState) then
    begin
      LoadLib(FLibFileName);
    end;
end;

procedure TBlockLibrary.LoadLib(AFileName: string);
var
  i: integer;
  Item: TListItem;
  Glyph: TBitmap;
  G: TGPGraphics;
  Sx, Sy: Float;
begin
  if Editor = nil then Exit;

  if (Length(AFileName) > 2) and (AFileName[2] <> ':') then
    AFileName := ExtractFilePath(ParamStr(0)) + AFileName;

  Items.Clear;
  if FDoc <> nil then FDoc.Free;

  FDoc := BlockDocument.Create(nil);
  FDoc.LoadFromTextFile(AFileName);

  for i := 0 to FDoc.BlockRoot.Blocks.Count - 1 do
  begin
    Glyph := TBitmap.Create;
    Glyph.Width := 48;
    Glyph.Height := 48;

    G := TGPGraphics.Create(Glyph.Canvas.Handle, 0, 0);
    G.SetPageUnit(UnitTypeToGPUnit(FDoc.UnitType));
    G.SetSmoothingMode(SmoothingModeAntiAlias);
    Sx := (FImages.Width - 4) / ConvertValue(FDoc.UnitType, FDoc.BlockRoot.Blocks[i].Width, Pixel);
    Sy := (FImages.Height - 4) / ConvertValue(FDoc.UnitType, FDoc.BlockRoot.Blocks[i].Height, Pixel);
    if Sx < Sy then
      G.SetPageScale(Sx)
    else
      G.SetPageScale(Sy);

    THackBlock(FDoc.BlockRoot.Blocks[i]).DrawBlock(G);
    G.Free;

    THackBlock(FDoc.BlockRoot.Blocks[i]).Loaded;

    Item := Items.Add;
    Item.ImageIndex := FImages.AddMasked(Glyph, $FF00FF);
    Item.Caption := FDoc.BlockRoot.Blocks[i].Text;
    FDoc.BlockRoot.Blocks[i].Text := '';
    Item.Data := FDoc.BlockRoot.Blocks[i];
  end;
  FDoc.UnitType := FEditor.UnitType;
end;

procedure TBlockLibrary.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;
  if (Operation = opRemove) and (AComponent = FEditor) then
    FEditor := nil;
end;

procedure TBlockLibrary.SetEditor(const Value: TBlockEditor);
begin
  FEditor := Value;
  if FEditor <> nil then
    FEditor.AddNotification(Self);
end;

procedure TBlockLibrary.SetLibFileName(const Value: string);
begin
  FLibFileName := Value;
end;

procedure TBlockLibrary.UpdateBlocks;
begin
  if FUpdating then Exit;
  FUpdating := true;
  try
    if not (csDesigning in ComponentState) then
    begin
      LoadLib(FLibFileName);
    end;
  finally
    FUpdating := false;
  end;
end;

{ TClassBlockLibrary }

constructor TClassBlockLibrary.Create(AOwner: TComponent);
begin
  inherited;
  FBlocks := TStringList.Create;
end;

destructor TClassBlockLibrary.Destroy;
begin
  FBlocks.Free;
  inherited;
end;

procedure TClassBlockLibrary.Loaded;
begin
  inherited;
  UpdateBlocks;
end;

procedure TClassBlockLibrary.SetBlocks(const Value: TStrings);
begin
  FBlocks.Assign(Value);
  UpdateBlocks;
end;

procedure TClassBlockLibrary.UpdateBlocks;
var
  D: BlockDocument;
  i: integer;
  Item: TListItem;
  Glyph: TBitmap;
  G: TGPGraphics;
  Sx, Sy: Float;
  B: Block;
  BClass: BlockClass;
begin
  if Editor = nil then Exit;
  if FUpdating then Exit;
  FUpdating := true;
  try
    Items.Clear;
    if FDoc <> nil then FDoc.Free;
    FDoc := BlockDocument.Create(nil);

    for i := 0 to FBlocks.Count - 1 do
    begin
      try
        BClass := BlockClass(FindClass(FBlocks[i]));
      except
      end;
      if BClass = nil then Continue;
      B := BClass.Create(FDoc);
      FDoc.BlockRoot.AddBlock(B);

      Glyph := TBitmap.Create;
      Glyph.Width := 48;
      Glyph.Height := 48;

      G := TGPGraphics.Create(Glyph.Canvas.Handle, 0, 0);
      G.SetPageUnit(UnitTypeToGPUnit(FDoc.UnitType));
      G.SetSmoothingMode(SmoothingModeAntiAlias);
      Sx := (FImages.Width - 4) / ConvertValue(FDoc.UnitType, B.Width, Pixel);
      Sy := (FImages.Height - 4) / ConvertValue(FDoc.UnitType, B.Height, Pixel);
      if Sx < Sy then
        G.SetPageScale(Sx)
      else
        G.SetPageScale(Sy);

      THackBlock(B).DrawBlock(G);
      G.Free;

      THackBlock(B).Loaded;

      Item := Items.Add;
      Item.ImageIndex := FImages.AddMasked(Glyph, $FF00FF);
      Item.Caption := B.BlockName;
      Item.Data := B;
    end;
    FDoc.UnitType := FEditor.UnitType;
  finally
    FUpdating := false;
  end;
end;

end.