unit FillForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Buttons, ComCtrls, StdCtrls, Grids,PCTypesUtils,DrawObjects;

type
  TfrmFill = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    Panel1: TPanel;
    SpeedButton2: TSpeedButton;
    SpeedButton1: TSpeedButton;
    bColor: TShape;
    fColor: TShape;
    Bevel1: TBevel;
    Bevel2: TBevel;
    Bevel3: TBevel;
    Bevel4: TBevel;
    CheckBox1: TCheckBox;
    HatchGrid: TStringGrid;
    GradGrid: TStringGrid;
    TextureGrid: TStringGrid;
    Label1: TLabel;
    Edit1: TEdit;
    rbTSmall: TRadioButton;
    rbTNormal: TRadioButton;
    rbTBig: TRadioButton;
    Label2: TLabel;
    cldlg: TColorDialog;
    bColorG: TShape;
    procedure TextureGridDrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure GradGridDrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure GradGridSelectCell(Sender: TObject; ACol, ARow: Integer;
      var CanSelect: Boolean);
    procedure TextureGridSelectCell(Sender: TObject; ACol, ARow: Integer;
      var CanSelect: Boolean);
    procedure HatchGridSelectCell(Sender: TObject; ACol, ARow: Integer;
      var CanSelect: Boolean);
    Procedure CreateHatchMetafiles;
    procedure HatchGridDrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure FormCreate(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure PageControl1Change(Sender: TObject);
  private
    { Private declarations }
    PCad: TObject;
    Procedure Apply;
  public
    { Public declarations }
    SelFigure : TFigure;
    FillType: TFillType;
    HatchStyle: THatchStyle;
    GradStyle: TGradStyle;
    TextureStyle: TTextureStyle;
    FillSize: Double;
    TextureSize: Integer;
    BackColor : TColor;
    ForeColor : TColor;
    Procedure SetControl(CadControl:TObject);
    Procedure Sync;
  end;

var
  frmFill: TfrmFill;
  HatchWmf: Array [1..1000] of TMetafile;
  OnApply : TNotifyEvent;

implementation

uses PCDrawing;

{$R *.dfm}

procedure TfrmFill.TextureGridDrawCell(Sender: TObject; ACol,
  ARow: Integer; Rect: TRect; State: TGridDrawState);
var index: Integer;
    xBmp: TBitmap;
begin
  TextureGrid.Canvas.Brush.Style := bsSolid;
  TextureGrid.Canvas.Brush.Color := clWhite;
  TextureGrid.Canvas.FillRect(Rect);
  index := (arow*6)+acol+1;
  if index <= ord(txtMediumWood) then begin
    xbmp := GetTextureBitmap(index);
    TextureGrid.Canvas.CopyRect(Classes.Rect(rect.left+2,rect.top+2,rect.Right-2,rect.Bottom-2),
                                xBmp.Canvas,Classes.Rect(2,2,46,46));
    if gdSelected in State then begin
      TextureGrid.Canvas.Brush.Style := bsClear;
      TextureGrid.Canvas.Pen.Color := clRed;
      TextureGrid.Canvas.Pen.Width := 3;
      TextureGrid.Canvas.Rectangle(Classes.Rect(rect.left+1,rect.top+1,rect.Right-1,rect.Bottom-1));
    end;
    xBmp.Free;
  end;
end;

procedure TfrmFill.GradGridDrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var index: Integer;
    xBmp: TBitmap;
begin
  GradGrid.Canvas.Brush.Style := bsSolid;
  GradGrid.Canvas.Brush.Color := clWhite;
  GradGrid.Canvas.FillRect(Rect);
  index := (arow*6)+acol+1;
  xBmp := nil;
  if index <= ord(gsMirrored) then begin
    MakeGradBitmap(bColorG.Brush.Color,fColor.Brush.Color,TGradStyle(index),xBmp);
    GradGrid.Canvas.StretchDraw(Classes.Rect(rect.left+2,rect.top+2,rect.Right-2,rect.Bottom-2),xBmp);
    if gdSelected in State then begin
      GradGrid.Canvas.Brush.Style := bsClear;
      GradGrid.Canvas.Pen.Color := clRed;
      GradGrid.Canvas.Pen.Width := 3;
      GradGrid.Canvas.Rectangle(Classes.Rect(rect.left+1,rect.top+1,rect.Right-1,rect.Bottom-1));
    end;
    xBmp.Free;
  end;
end;

procedure TfrmFill.SpeedButton2Click(Sender: TObject);
begin
  clDlg.Color := bColor.Brush.Color;
  if clDlg.Execute then begin
    if PageControl1.TabIndex = 0 then begin
      bColor.Brush.Color := clDlg.Color;
    end else begin
      bColorG.Brush.Color := clDlg.Color;
    end;
    HatchGrid.Refresh;
    GradGrid.Refresh;
    Apply;
  end;
end;

procedure TfrmFill.SpeedButton1Click(Sender: TObject);
begin
  clDlg.Color := fColor.Brush.Color;
  if clDlg.Execute then begin
    fColor.Brush.Color := clDlg.Color;
    HatchGrid.Refresh;
    GradGrid.Refresh;
    Apply;
  end;

end;

procedure TfrmFill.GradGridSelectCell(Sender: TObject; ACol, ARow: Integer;
  var CanSelect: Boolean);
begin
  if (acol = 5) and (arow = 3) then begin
    CanSelect := False;
  end else begin
    canSelect := True;
  end;
end;

procedure TfrmFill.TextureGridSelectCell(Sender: TObject; ACol,
  ARow: Integer; var CanSelect: Boolean);
var index: Integer;
begin
  index := (arow*6)+acol+1;
  if index > 24 then begin
    CanSelect := False;
  end else CanSelect := True;
end;

procedure TfrmFill.HatchGridSelectCell(Sender: TObject; ACol,
  ARow: Integer; var CanSelect: Boolean);
var index: Integer;
begin
  index := (arow*6)+acol+1;
  if index > 11 then begin
    CanSelect := False;
  end else CanSelect := True;
end;

procedure TfrmFill.CreateHatchMetafiles;
var i: Integer;
    figure: TRectangle;
begin
  for i := 1 to 11 do begin
    figure := TRectangle.create(0,0,12,12,2,ord(psSolid),clBlack,ord(bsClear),clBlack,0,PCTypesUtils.mydsNormal,TComponent(PCad));
    figure.Brs := ord(bsExHatch);
    figure.ExHatchStyle := THatchStyle(i);
    figure.ResetRegion;
    HatchWmf[i] := TPCdrawing(PCad).FigureAsWmf(figure.Handle,false);
    figure.Free;
    //HatchWmf[i].SaveToFile('c:\hatch'+inttostr(i)+'.wmf');
  end;
end;

procedure TfrmFill.SetControl(CadControl: TObject);
begin
  if PCad <> CadControl then begin
    PCad := CadControl;
    if CadControl <> nil then CreateHatchMetafiles;
  end;
end;

procedure TfrmFill.HatchGridDrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var index: Integer;
begin
  HatchGrid.Canvas.Brush.Style := bsSolid;
  HatchGrid.Canvas.Brush.Color := clWhite;
  HatchGrid.Canvas.FillRect(Rect);
  index := (arow*6)+acol+1;
  if index <= 11 then begin

    HatchGrid.Canvas.StretchDraw(Classes.Rect(rect.left+2,rect.top+2,rect.Right-2,rect.Bottom-2),HatchWmf[index]);
    if gdSelected in State then begin
      HatchGrid.Canvas.Brush.Style := bsClear;
      HatchGrid.Canvas.Pen.Color := clRed;
      HatchGrid.Canvas.Pen.Width := 3;
      HatchGrid.Canvas.Rectangle(Classes.Rect(rect.left+1,rect.top+1,rect.Right-1,rect.Bottom-1));
    end;
  end;

end;

procedure TfrmFill.FormCreate(Sender: TObject);
begin
  OnApply := nil;
end;

procedure TfrmFill.Button3Click(Sender: TObject);
begin
  Apply;
end;

procedure TfrmFill.Apply;
var index: Integer;
begin
  if PageControl1.TabIndex = 0 then begin
    FillType := fsHatch;
    index := HatchGrid.Row*6+HatchGrid.Col+1;
    if index < 1 then index := 1;
    HatchStyle := THatchStyle(index);
    FillSize := MakeFloat(Edit1.Text,2);
    BackColor := bColor.Brush.Color;
    if CheckBox1.Checked then BackColor := clNone;
  end else if PageControl1.TabIndex = 1 then begin
    FillType := fsGradient;
    index := GradGrid.Row*6+GradGrid.Col+1;
    if index < 1 then index := 1;
    GradStyle := TGradStyle(index);
    BackColor := bColorG.Brush.Color;
  end else if PageControl1.TabIndex = 2 then begin
    FillType := fsTexture;
    index := TextureGrid.Row*6+TextureGrid.Col+1;
    if index < 1 then index := 1;
    TextureStyle := TTextureStyle(index);
    if rbTSmall.Checked then TextureSize := 1
    else if rbTNormal.Checked then TextureSize := 2
    else if rbTBig.Checked then TextureSize := 3;
  end;
  ForeColor := fColor.Brush.Color;


  if assigned(OnApply) then OnApply(Self);
end;

procedure TfrmFill.Button1Click(Sender: TObject);
begin
  Apply;
  Self.Close;
end;

procedure TfrmFill.Button2Click(Sender: TObject);
begin
  Self.Close;
end;

procedure TfrmFill.Sync;
var index,aCol,aRow: Integer;
begin
  FillType := GetFillType(SelFigure.brs);
  if SelFigure.brs = bsExHatch then
    HatchStyle := SelFigure.ExHatchStyle
  else
    HatchStyle := GetHatchStyle(SelFigure.brs);

  if SelFigure.brs = bsExGrad then
    GradStyle := SelFigure.ExGradStyle
  else
    GradStyle := GetGradStyle(SelFigure.brs);

  if SelFigure.brs = bsExTexture then
    TextureStyle := SelFigure.ExTextureStyle
  else
    TextureStyle := GetTextureStyle(SelFigure.brs);

  FillSize := SelFigure.ExHatchStepSize;
  TextureSize := SelFigure.ExTextureSize;
  BackColor := SelFigure.ExFillBackColor;
  ForeColor := SelFigure.Brc;

  if FillType = fsHatch then begin
    PageControl1.TabIndex := 0;
    index := ord(HatchStyle)-1;
    aRow := Trunc(index / 6);
    aCol := index - (aRow*6);
    HatchGrid.Col := aCol;
    HatchGrid.Row := aRow;
    Edit1.Text := FloatToStr(FillSize);
    BColor.Brush.Color := BackColor;
    if BackColor = clNone then
      BColorG.Brush.Color := clWhite
    else
      BColorG.Brush.Color := BackColor;
  end else if FillType = fsGradient then begin
    PageControl1.TabIndex := 1;
    index := ord(GradStyle)-1;
    aRow := Trunc(index / 6);
    aCol := index - (aRow*6);
    GradGrid.Col := aCol;
    GradGrid.Row := aRow;
    if BackColor = clNone then
      BColorG.Brush.Color := clWhite
    else
      BColorG.Brush.Color := BackColor;
    BColor.Brush.Color := BackColor;
  end else if FillType = fsTexture then begin
    PageControl1.TabIndex := 2;
    index := ord(TextureStyle)-1;
    aRow := Trunc(index / 6);
    aCol := index - (aRow*6);
    TextureGrid.Col := aCol;
    TextureGrid.Row := aRow;
    rbTSmall.Checked := (TextureSize <= 1);
    rbTNormal.Checked := (TextureSize = 2);
    rbTBig.Checked := (TextureSize >= 3);
    BColor.Brush.Color := BackColor;
    if BackColor = clNone then
      BColorG.Brush.Color := clWhite
    else
      BColorG.Brush.Color := BackColor;
  end else begin
    PageControl1.TabIndex := 0;
    HatchGrid.Col := 0;
    HatchGrid.Row := 0;
    BColor.Brush.Color := BackColor;
    if BackColor = clNone then
      BColorG.Brush.Color := clWhite
    else
      BColorG.Brush.Color := BackColor;
  end;
  Panel1.Visible := (PageControl1.TabIndex <> 2);
  bColor.Visible := (PageControl1.TabIndex = 0);
  bColorG.Visible := (PageControl1.TabIndex = 1);
  CheckBox1.Visible := (PageControl1.TabIndex = 0);
  FColor.Brush.Color := ForeColor;
  CheckBox1.Checked := (BackColor = clNone);
  if CheckBox1.Checked then bColor.Brush.Style := bsClear else bColor.Brush.Style := bsSolid;
end;

procedure TfrmFill.CheckBox1Click(Sender: TObject);
begin
  if CheckBox1.Checked then backColor := clNone else backColor := clWhite;
  bColor.Brush.Color := BackColor;
  if CheckBox1.Checked then bColor.Brush.Style := bsClear else bColor.Brush.Style := bsSolid;
end;

procedure TfrmFill.PageControl1Change(Sender: TObject);
begin
  CheckBox1.Visible := (PageControl1.TabIndex = 0);
  if pagecontrol1.TabIndex > 0 then begin
    bColor.Brush.Style := bsSolid;
  end;
  Panel1.Visible := (PageControl1.TabIndex <> 2);
  bColor.Visible := (PageControl1.TabIndex = 0);
  bColorG.Visible := (PageControl1.TabIndex = 1);
end;

end.