mirror of
http://gitlab.expertsoft.com.ua/git/expertcad
synced 2026-01-11 17:25:39 +02:00
137 lines
3.3 KiB
ObjectPascal
137 lines
3.3 KiB
ObjectPascal
unit LayerDial;
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
|
PCFormRoll, ComCtrls, ToolWin, Menus, ExtCtrls, Buttons, StdCtrls, checklst,
|
|
Grids,DrawObjects;
|
|
|
|
Type TCommandEvent = procedure ( comId: integer; values: string; valueI: integer ) of object;
|
|
|
|
|
|
type
|
|
TLayerD = class(TForm)
|
|
Title: TScrollBox;
|
|
pMenu: TPopupMenu;
|
|
NewLayer1: TMenuItem;
|
|
DeleteLayer1: TMenuItem;
|
|
N1: TMenuItem;
|
|
MergeVisible1: TMenuItem;
|
|
MergeAll1: TMenuItem;
|
|
N2: TMenuItem;
|
|
FlueAllInactives1: TMenuItem;
|
|
HideAllInactives1: TMenuItem;
|
|
But: TSpeedButton;
|
|
ScrollBox1: TScrollBox;
|
|
Grid: TStringGrid;
|
|
Panel1: TPanel;
|
|
Bevel1: TBevel;
|
|
ActiveLabel: TLabel;
|
|
ShowAll1: TMenuItem;
|
|
imgVis: TImage;
|
|
imgGrayed: TImage;
|
|
procedure ButClick(Sender: TObject);
|
|
procedure FormCreate(Sender: TObject);
|
|
procedure NewLayer1Click(Sender: TObject);
|
|
procedure DeleteLayer1Click(Sender: TObject);
|
|
procedure GridSelectCell(Sender: TObject; Col, Row: Integer;
|
|
var CanSelect: Boolean);
|
|
procedure GridDrawCell(Sender: TObject; ACol, ARow: Integer;
|
|
Rect: TRect; State: TGridDrawState);
|
|
private
|
|
{ Private declarations }
|
|
|
|
public
|
|
{ Public declarations }
|
|
end;
|
|
|
|
var
|
|
LayerD: TLayerD;
|
|
wr: TPCRoller;
|
|
OnCommand : TCommandEvent;
|
|
const
|
|
NewId = 0;
|
|
DelId = 1;
|
|
MergeVId = 2;
|
|
MergeAId = 3;
|
|
FlueId = 4;
|
|
HideId = 5;
|
|
|
|
implementation
|
|
|
|
{$R *.DFM}
|
|
|
|
procedure TLayerD.ButClick(Sender: TObject);
|
|
var pS,pD : TPoint;
|
|
begin
|
|
pS.x := but.left+but.width;
|
|
pS.y := but.top;
|
|
pD := title.clienttoscreen(pS);
|
|
pMenu.Popup(pD.x,pD.y);
|
|
end;
|
|
|
|
|
|
procedure TLayerD.FormCreate(Sender: TObject);
|
|
begin
|
|
wr := TPCRoller.create(self);
|
|
wr.Enabled := true;
|
|
end;
|
|
|
|
procedure TLayerD.NewLayer1Click(Sender: TObject);
|
|
var layerName: string;
|
|
begin
|
|
If InputQuery('New Layer','Enter Name for The layer', LayerName)
|
|
then
|
|
if assigned(OnCommand) then OnCommand((sender as TMenuItem).tag,LayerName,0);
|
|
end;
|
|
|
|
procedure TLayerD.DeleteLayer1Click(Sender: TObject);
|
|
begin
|
|
if assigned(OnCommand) then OnCommand((sender as TMenuItem).tag,'',0);
|
|
end;
|
|
|
|
|
|
procedure TLayerD.GridSelectCell(Sender: TObject; Col, Row: Integer;
|
|
var CanSelect: Boolean);
|
|
begin
|
|
If col = 0 then
|
|
begin
|
|
if assigned(OnCommand) then OnCommand(6,'',row);
|
|
end;
|
|
If col = 1 then
|
|
begin
|
|
if assigned(OnCommand) then OnCommand(7,'',row);
|
|
end;
|
|
If col = 2 then
|
|
begin
|
|
if assigned(OnCommand) then OnCommand(8,'',row);
|
|
end;
|
|
end;
|
|
|
|
procedure TLayerD.GridDrawCell(Sender: TObject; ACol, ARow: Integer;
|
|
Rect: TRect; State: TGridDrawState);
|
|
var xtxt: String;
|
|
begin
|
|
Grid.Canvas.Brush.Color := clWhite;
|
|
Grid.Canvas.Brush.Style := bsSolid;
|
|
Grid.Canvas.FillRect(Rect);
|
|
Grid.Canvas.Brush.Style := bsClear;
|
|
xtxt := Grid.Cells[aCol,aRow];
|
|
if acol = 0 then begin
|
|
Grid.Canvas.Font := Grid.Font;
|
|
Grid.Canvas.TextOut(Rect.Left+2,Rect.Top+2,xtxt);
|
|
end else if acol = 1 then begin
|
|
if Trim(xtxt) = 'V' then begin
|
|
Grid.Canvas.Draw(Rect.Left+1,Rect.Top+2,imgVis.Picture.Bitmap);
|
|
end;
|
|
end else if acol = 2 then begin
|
|
if Trim(xtxt) = 'F' then begin
|
|
Grid.Canvas.Draw(Rect.Left+1,Rect.Top+2,imgGrayed.Picture.Bitmap);
|
|
end;
|
|
|
|
end;
|
|
end;
|
|
|
|
end.
|