unit PCPanel;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls,CanvasPanel,buttons,PCScrollBar,Menus,
  PCTypesUtils;

type
  TRulerType = (rtDeciMilim , rtHalfMilim, rtMilim, rtHalfCMeter, rtCentiMeter,
  rtDeciMeter);


  TRulerPanel = class(TCanvasPanel)
  end;
  (*vbclassexport begin*)
  TPCPanel = class(TCustomPanel)
  private
    { Private declarations }
    FRulerVisible : Boolean;
    FPanelVisible : Boolean;
    FRulerStart : TPoint;
    HStart : integer;
    VStart : integer;

    Fdpm: Double;
    FPosition : TPoint;
    FRType : TRulerType;
    FOnZoomIn : TNotifyEvent;
    FOnZoomOut : TNotifyEvent;
    FOnZoomArea : TNotifyEvent;
    FOnActualSize : TNotifyEvent;
    FOnFitToWindow : TNotifyEvent;
    FVertZero: TVertZero;
    FHorzZero: THorzZero;
    fLock: Boolean;
    fUpdated: Boolean;
    FAutoRefresh: Boolean;
    procedure setVertZero(const Value: TVertZero);
    procedure setHorzZero(const Value: THorzZero);
    procedure CNKeyDown(var Message: TWMKeyDown); message CN_KEYDOWN;
    function IsMenuKey(var Message: TWMKey): Boolean;
    procedure SetAutoRefresh(const Value: Boolean);
  protected
    { Protected declarations }
    FEventEngines: TList;
    Procedure DoZoomIn;virtual;
    Procedure DoZoomOut;virtual;
    Procedure DoZoomArea;virtual;
    Procedure DoZoomActualSize;virtual;
    Procedure DoZoomFitToWindow;virtual;
    Procedure WhenResize(sender: TObject);
    Procedure WhenDOver(Sender, Source: TObject; X, Y: Integer; State: TDragState;var Accept: Boolean);
    Procedure raiseEvent(sender: TObject);
    Procedure setRuler(Value: TPoint);
    Procedure setRulerType(value : TRulerType);
    Procedure setDpm(value: Extended);
    Procedure setPosition(value: TPoint);
    Procedure setRulerVisible(value: boolean);
    Procedure SyncEnv;virtual;
    Procedure ROChanged;virtual;
    Function DoKeyEvents( Message: TWMKey): Boolean;virtual;

    Function GetBackColor:Tcolor;virtual;
  public
    { Public declarations }
    evRulers    : TEventEngine;
    evRulerSys  : TEventEngine;

    Container   : TScrollBox;
    CustomSurface:TCanvas;
    CustomWnd: HWND;
    Procedure PrintMessage(Mes:String);Virtual;(*vb*)
    Procedure Refresh;virtual; (*vb*)
    Function ClientToScreen(const Point: TPoint): TPoint;(*vb*)
    function ScreenToClient(const Point: TPoint): TPoint;(*vb*)
    Function RegisterEvent(EventId:Integer;Client: TObject;CallBackProc:TEventCallBack):Pointer;overload;
    Function RegisterEvent(EventId:Integer;Client: Integer;CallBackProc:TEventCallBack):Pointer;overload;
    Procedure UnRegisterEvent(EventId:Integer;EventHandle:Pointer);
    Function FindEventEngine(EventId: Integer):TEventEngine;
    Function EventEngine(EventId: Integer;NumVal:Integer;StrVal:String;DblVal:Double):TEventEngine;
    Constructor create(aowner: Tcomponent);override;
    Destructor Destroy;override;
    Procedure SetCustomSurface(CWindow:HWnD; CDC:HDC);virtual;(*vb*)
    Procedure DoResize;(*vb*)
    Property TracePosition: TPoint read FPosition write setPosition;
    Property DotsPerMil: Double read Fdpm;(*vb*)
    Property RulerStart: TPoint read FRulerStart write setRuler;
    Property RulerType : TRulerType read FRType write setRulerType;
    Property Locked: Boolean read fLock write fLock;(*vb*)
    Property Updated: Boolean read fUpdated write fUpdated; (*vb*)
    Property AutoRefresh : Boolean read FAutoRefresh write SetAutoRefresh; (*vb*)
    property DockManager;
  published
    { Published declarations }
    Property RulerVisible : Boolean read FRulerVisible write setRulerVisible;(*vb*)
    Property VerticalZero : TVertZero read FVertZero write setVertZero;(*vb*)
    Property HorizontalZero : THorzZero read FHorzZero write setHorzZero;(*vb*)
    property Align;
    property BevelInner;
    property BevelOuter;
    property BorderWidth;
    property BorderStyle;
    property Visible;
    Property OnKeyDown;
    Property OnKeyUp;
    Property OnZoomIn: TnotifyEvent read FOnZoomIn write FOnZoomIn;(*vb*)
    Property OnZoomOut: TnotifyEvent read FOnZoomOut write FOnZoomOut;(*vb*)
    Property OnZoomArea: TnotifyEvent read FOnZoomArea write FOnZoomArea;(*vb*)
    Property OnZoomActualSize: TnotifyEvent read FOnActualSize write FOnActualSize; (*vb*)
    Property OnZoomFitToWindow: TNotifyEvent read FOnFitToWindow write FOnFitToWindow; (*vb*)
  end;
  (*vbclassexport end*)
implementation
uses U_Common, U_BaseCommon;

{$R *.RES}
{$R *.DCR}

Constructor TPCPanel.create(aowner: Tcomponent);
begin
  inherited create(aowner);
  Container  := TScrollBox.create(self);
  Container.DoubleBuffered := True;
  caption := '';

  Onresize := WhenResize;
  Container.align   := alclient;
  Container.parent  := self;
  Container.visible := true;
  Container.color := clwhite;
  FvertZero := vzTop;
  FHorzZero := vzLeft;
  Fdpm := 4;
  FRulerStart.x := - 5000;
  FRulerStart.y := - 5000;
  FRType := rtMilim;
  FPosition.x := -5000;
  FPosition.y := -5000;
  FRulerVisible := True;
  FPanelVisible := True;
  FEventEngines := TList.Create;
  evRulers :=  EventEngine(cRulers,1,'',0);
end;

Procedure TPCPanel.setDpm(value: extended);
begin
  Fdpm := value;
end;


Procedure TPCPanel.setRulerVisible(value: Boolean);
begin
  FRulerVisible := value;
  evRulers.RaiseEvent(value);
  Refresh;
  SyncEnv;
end;


Procedure TPCPAnel.raiseEvent(sender: TObject);
Var Button : TSpeedButton;
    Idx : Integer;
Begin

  if not (sender is TSpeedButton) then exit;
  Button := (sender as TSpeedButton);
  Idx := Button.Tag;

  case Idx Of
    1: begin
         DoZoomIn;

       end;
    2: begin
         DoZoomOut;

       end;
    3: begin
         DoZoomArea;

       end;
    4: begin
         DoZoomActualSize;

       end;
    5: begin
         DoZoomFitToWindow;

       end;

  end;
End;


Procedure TPCPAnel.WhenResize(sender: TObject);
Var p: TPoint;
begin
  if FrulerStart.x = -5000 then
  begin
    p.x:= 0; p.y:=0;
    setruler(ClientToScreen(p));
  end;
end;


Procedure TPCPAnel.setRuler(value: TPoint);
begin
  FRulerStart.x := Value.x;
  FRulerStart.y := Value.y;
end;

Procedure TPCPAnel.setPosition(value: TPoint);
var HPos,vpos : integer;
    cPoint : TPoint;
begin
  If (not RulerVisible) then
  begin
    FPosition := value;
    exit;
  end;
  (*
  FrulerH.canvas.pen.mode := PmXor;
  FrulerH.canvas.pen.color := clSilver xor clred;
  FrulerH.canvas.pen.style := psDot;
  FrulerV.canvas.pen.mode := PmXor;
  FrulerV.canvas.pen.color := clSilver xor ClRed;
  FrulerV.canvas.pen.style := psDot;
  cPoint := FRulerH.screentoclient(FPosition);
  HPos := cpoint.x;
  cPoint := FRulerV.screentoclient(FPosition);
  VPos := cpoint.y;
  FRulerH.Canvas.moveto(HPos,0);
  FRulerH.Canvas.lineto(HPos,FrulerH.Height);
  FRulerV.Canvas.moveto(0,VPos);
  FRulerV.Canvas.lineto(FrulerV.Width,VPos);
  FPosition := value;
  cPoint := FRulerH.screentoclient(FPosition);
  HPos := cpoint.x;
  cPoint := FRulerV.screentoclient(FPosition);
  VPos := cpoint.y;
  FRulerH.Canvas.moveto(HPos,0);
  FRulerH.Canvas.lineto(HPos,FrulerH.Height);
  FRulerV.Canvas.moveto(0,VPos);
  FRulerV.Canvas.lineto(FrulerV.Width,VPos);
  FrulerH.canvas.pen.mode := PmCopy;
  FrulerH.canvas.pen.color := ClBlack;
  FrulerH.canvas.pen.style := psSolid;
  FrulerV.canvas.pen.mode := PmCopy;
  FrulerV.canvas.pen.color := ClBlack;
  FrulerV.canvas.pen.style := psSolid;
  *)
end;

Procedure TPCPAnel.setRulerType(value: TRulerType);
begin
  if Value <> FRtype then //07.08.2012
  begin
    FRtype := Value;
    Refresh;
  end;
end;

Procedure TPCPanel.WhenDOver(Sender, Source: TObject; X, Y: Integer; State: TDragState;var Accept: Boolean);
var cp : TcanvasPanel;
begin
  if not(sender is TCanvasPanel) then exit;
  cp := sender as TCanvasPanel;
end;

Procedure TPCPanel.SyncEnv;
Begin

End;

Procedure TPCPanel.DoZoomIn;
begin
  if assigned(FOnZoomIn) then FOnZoomIn(self);
end;
Procedure TPCPanel.DoZoomOut;
begin
  if assigned(FOnZoomOut) then FOnZoomOut(self);
end;

Procedure TPCPanel.DoZoomArea;
begin
  if assigned(FOnZoomArea) then FOnZoomArea(self);
end;

Procedure TPCPanel.DoZoomActualSize;
begin
  if assigned(FOnActualSize) then FOnActualSize(self);
end;

Procedure TPCPanel.DoZoomFitToWindow;
begin
  if assigned(FOnFitToWindow) then FOnFitToWindow(self);
end;



procedure TPCPanel.setHorzZero(const Value: THorzZero);
begin
  FHorzZero := Value;
  Refresh;
  ROChanged;
end;

procedure TPCPanel.setVertZero(const Value: TVertZero);
begin
  FVertZero := Value;
  Refresh;
  ROChanged;
end;

Procedure TPCPanel.ROChanged;
begin
end;

procedure TPCPanel.CNKeyDown(var Message: TWMKeyDown);
begin
 Message.Result := 1;
 if DoKeyEvents(Message) then exit;
 if IsMenuKey(Message) then Exit;
// GetParentForm(Self).Perform(CM_DIALOGKEY, CharCode, KeyData) <> 0) then Exit
 inherited;
// Message.Result := 0;
end;

function TPCPanel.IsMenuKey(var Message: TWMKey): Boolean;
var
  Form: TCustomForm;
  LocalPopupMenu: TPopupMenu;
begin
  Result := True;
  if not (csDesigning in ComponentState) then
  begin

    LocalPopupMenu := PopupMenu;
    if Assigned(LocalPopupMenu) and (LocalPopupMenu.WindowHandle <> 0) and
       LocalPopupMenu.IsShortCut(Message) then Exit;

    Form := GetParentForm(Self);
    if (Form <> nil) and Form.IsShortCut(Message) then Exit;
  end;
  Result := False;
end;

function TPCPanel.DoKeyEvents(Message: TWMKey): Boolean;
begin
  result := false;
end;

Function TPCPanel.FindEventEngine(EventId: Integer):TEventEngine;
var i: Integer;
    Engine: TEventEngine;
Begin
  Result := nil;
  For i := 0 to FeventEngines.Count - 1 do
  begin
    Engine := TEventEngine(FeventEngines[i]);
    if Engine.EventId = EventId then begin
      Result := Engine;
      Exit;
    end;
  end;
End;

Function TPCPanel.RegisterEvent(EventId: Integer;
  Client: TObject;CallBackProc: TEventCallBack):Pointer;
Var Engine: TEventEngine;
begin
  Result := nil;
  Engine := FindEventEngine(EventId);
  if Assigned(Engine) then
    Result := Engine.RegisterClient(Client,CallbackProc);
end;

procedure TPCPanel.UnRegisterEvent(EventId: Integer;
  Eventhandle: Pointer);
Var Engine: TEventEngine;
begin
  Engine := FindEventEngine(EventId);
  if Assigned(Engine) then
    Engine.UnRegisterClient(EventHandle);
end;

Function TPCPanel.EventEngine(EventId: Integer;NumVal:Integer;StrVal:String;DblVal:Double):TEventEngine;
begin
  Result := TEventEngine.Create(EventId,NumVal,StrVal,DblVal);
  FEventEngines.Add(Result);
end;

procedure TPCPanel.SetCustomSurface(CWindow: HWnD; CDC:HDC);
var xCanvas:TCanvas;

begin
  if CWindow = 0 then begin
    CustomSurface := nil;
    CustomWnd := 0;
  end else begin
    CustomWnd := CWindow;
    xCanvas := TControlCanvas.Create;
    if CDC = 0 then cdc := GetDc(CWindow);
    xCanvas.Handle := cdc;
    CustomSurface := xCanvas;
  end;
end;

function TPCPanel.GetBackColor: Tcolor;
begin
  result := clSilver;
end;


procedure TPCPanel.DoResize;
begin
  WhenResize(nil);
end;

function TPCPanel.ClientToScreen(const Point: TPoint): TPoint;
begin
  if CustomWnd = 0 then
    result := inherited ClientToScreen(point)
  else begin
    Result := Classes.Point(point.x,point.y);
    Windows.ClientToScreen(CustomWnd, Result);
  end;
end;

function TPCPanel.ScreenToClient(const Point: TPoint): TPoint;
begin
  if CustomWnd = 0 then
    result := inherited ScreenToClient(point)
  else begin
    Result := Classes.Point(point.x,point.y);
    Windows.ScreenToClient(CustomWnd, Result);
  end;
end;

procedure TPCPanel.Refresh;
begin

end;

destructor TPCPanel.Destroy;
var
  i: Integer;
begin
  try
    for i := 0 to FEVentEngines.Count-1 do
    begin
      TeventEngine(FEVentEngines[i]).Free;
    end;
    FEventEngines.Free;
    inherited destroy;
  except
//    on E: Exception do AddExceptionToLog(CPowerCadMessage + 'TPCPanel.Destroy' + E.Message);
  end;
end;

procedure TPCPanel.PrintMessage(Mes: String);
begin

end;

procedure TPCPanel.SetAutoRefresh(const Value: Boolean);
begin
  FAutoRefresh := Value;
end;

function TPCPanel.RegisterEvent(EventId: Integer; Client: Integer;
  CallBackProc: TEventCallBack): Pointer;
Var Engine: TEventEngine;
begin
  Result := nil;
  Engine := FindEventEngine(EventId);
  if Assigned(Engine) then
    Result := Engine.RegisterClient(TObject(Client),CallbackProc);
end;

end.