unit U_CADObjectView; interface uses Windows, U_LNG, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Printers, ActnList, ActnMan, siComp, siLngLnk, ExtCtrls, PCPanel, PCDrawBox, PCDrawing, PowerCad, PrvForm, StdCtrls, RzCmboBx, ComCtrls, ToolWin, Dialogs, // PowerCad pcMsbar, PCTypesUtils, DrawObjects, DlgBase, ExtDlgs, PCLayerDlg, OleCtnrs, PCgui, GuiStrings, DrawEngine, Math, PlatformDefaultStyleActnCtrls; type TF_CADObjectView = class(TForm) lng_Forms: TsiLangLinked; ControlBar1: TControlBar; PCad: TPowerCad; ToolBar1: TToolBar; ToolButton1: TToolButton; ToolButton2: TToolButton; ActionManager: TActionManager; aZoomIn: TAction; aZoomOut: TAction; ToolButton3: TToolButton; aPrint: TAction; aZoom: TAction; ToolButton4: TToolButton; ToolButton5: TToolButton; cbZoomScale: TRzComboBox; Label1: TLabel; VerScroll: TScrollBar; HorScroll: TScrollBar; procedure FormDestroy(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormResize(Sender: TObject); procedure aZoomInExecute(Sender: TObject); procedure aZoomOutExecute(Sender: TObject); procedure aPrintExecute(Sender: TObject); procedure cbZoomScaleKeyPress(Sender: TObject; var Key: Char); procedure FormMouseWheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); procedure FormMouseWheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); procedure cbZoomScaleCloseUp(Sender: TObject); procedure VerScrollScroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer); procedure HorScrollScroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer); procedure PCadScaleChanged(Sender: TObject); procedure PCadKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); private { Private declarations } FScaleByCursor: Boolean; // позиционировать по курсору // если есть горизонтальные скроллы Function IfVisibleHorScrollBar: Boolean; // если есть вертикальные скроллы Function ifVisibleVerScrollBar: Boolean; // максимальная позиция скроллов PCAD Function GetMaxScrollsPosition: TPoint; // получение размера скроллов PCAD Function GetPageSizesScrolls: TPoint; // установка позиции скроллов PCAD Procedure Set_PCad_HorScroll; Procedure Set_PCad_VerScroll; // установка позиции наших скроллов Procedure Set_SCS_HorScroll; Procedure Set_SCS_VerScroll; // для масштабирования - получение коэффициентов для формулы function GetScaleKoefs: TDoublePoint; // изменение скролов при изменении размеров листа КАД Procedure ChangeScrollsOnChangeListSize; public { Public declarations } procedure SetZoomScale(AScale: Integer); procedure ZoomObject(AMoveToZero: Boolean=true); end; procedure CreateFCADObjectView; var F_CADObjectView: TF_CADObjectView; implementation uses USCS_Main, U_CAD, U_Common, Types, U_BaseCommon; {$R *.dfm} procedure TF_CADObjectView.FormDestroy(Sender: TObject); begin try except on E: Exception do AddExceptionToLogExt(ClassName, MethodName(@TF_CADObjectView.FormDestroy), E.Message); end; end; procedure TF_CADObjectView.FormCreate(Sender: TObject); begin try PCad.OnMouseWheel := nil; FScaleByCursor := true; except on E: Exception do AddExceptionToLogExt(ClassName, MethodName(@TF_CADObjectView.FormCreate), E.Message); end; end; procedure TF_CADObjectView.SetZoomScale(AScale: Integer); begin if (aScale >= 10) and (PCad.ZoomScale <> aScale) then begin PCad.ZoomScale := aScale; cbZoomScale.Text := IntToStr(aScale); end; end; procedure TF_CADObjectView.ZoomObject(AMoveToZero: Boolean=true); var SelRect: TDoubleRect; begin PCad.Refresh; if AMoveToZero then begin //PCad.SelectAll(0); //SelRect := PCad.GetSelectionRect; SelRect := PCad.GetFigureListRect(PCad.Figures); // Перемещаем все в начало //PCad.MoveSelection(0-SelRect.Left, 0-SelRect.Top); PCad.MoveAllSilent(10-SelRect.Left, 10-SelRect.Top); //F_CADObjectView.PCad.DeSelectAll(0); //F_CADObjectView.PCad.SelectAll(0); //F_CADObjectView.PCad.Refresh; //PCad.DeSelectAll(0); end; // Масштабируем //SelRect := PCad.GetSelectionRect; SelRect := PCad.GetFigureListRect(PCad.Figures); SelRect.Right := SelRect.Right + 5; SelRect.Bottom := SelRect.Bottom + 5; PCad.ZoomArea(SelRect); // Zoom Center //F_CADObjectView.PCad.AutoRefresh := false; PCad.ZoomScale := F_CADObjectView.PCad.ZoomScale; PCad.Refresh; cbZoomScale.Text := IntToStr(PCad.ZoomScale); ChangeScrollsOnChangeListSize; end; procedure CreateFCADObjectView; begin if F_CADObjectView = nil then begin F_CADObjectView := TF_CADObjectView.Create(Application); F_CADObjectView.PCad.AutoRefresh := false; end; F_CADObjectView.PCad.ClearFigures; end; procedure TF_CADObjectView.FormResize(Sender: TObject); begin ZoomObject; end; procedure TF_CADObjectView.aZoomInExecute(Sender: TObject); begin SetZoomScale(PCad.ZoomScale + 5); end; procedure TF_CADObjectView.aZoomOutExecute(Sender: TObject); begin SetZoomScale(PCad.ZoomScale - 5); end; procedure TF_CADObjectView.aPrintExecute(Sender: TObject); var prnW,prnH: Integer; resX,resY: Integer; pw, ph: integer; begin Printer.Orientation := TPrinterOrientation(0); prnW := GetDeviceCaps(printer.Handle, PHYSICALWIDTH); prnH := GetDeviceCaps(printer.Handle, PHYSICALHEIGHT); resX := GetDeviceCaps(printer.Handle, LOGPIXELSX); resY := GetDeviceCaps(printer.Handle, LOGPIXELSY); pw := round(prnW / (resX / 25.4)); ph := round(prnH / (resY / 25.4)); Init_prnW := round(prnW * (PCad.WorkWidth / pw)); Init_prnH := round(prnH * (PCad.WorkHeight / ph)); PCad.PrintPreview; end; procedure TF_CADObjectView.cbZoomScaleKeyPress(Sender: TObject; var Key: Char); var Scale: Integer; begin if Key = #13 then begin Scale := StrToIntDef(cbZoomScale.Text, -1); if Scale <> -1 then SetZoomScale(Scale); end else if Not (Key in ['0'..'9']) then Key := #0; end; procedure TF_CADObjectView.FormMouseWheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); var X, Y: Integer; begin Handled := True; PCad.AutoRefresh := False; if ssCtrl in Shift then aZoomOut.Execute else // Scrolls (Horiz) if (ssShift in Shift) and not (ssCtrl in Shift) then begin X := PCad.HSCBarPosition; PCad.SetHScrollPosition(X + 10, True); end else // Scrolls (Vert) if Shift = [] then begin Y := PCad.VSCBarPosition; PCad.SetVScrollPosition(Y + 10, True); end; // скролл Set_SCS_HorScroll; Set_SCS_VerScroll; PCad.AutoRefresh := True; RefreshCAD_T(PCad, true); end; procedure TF_CADObjectView.FormMouseWheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean); var X, Y: Integer; begin Handled := True; PCad.AutoRefresh := False; if ssCtrl in Shift then aZoomIn.Execute else // Scrolls (Horiz) if (ssShift in Shift) and not (ssCtrl in Shift) then begin X := PCad.HSCBarPosition; PCad.SetHScrollPosition(X - 10, True); end else // Scrolls (Vert) if Shift = [] then begin Y := PCad.VSCBarPosition; PCad.SetVScrollPosition(Y - 10, True); end; // скролл Set_SCS_HorScroll; Set_SCS_VerScroll; PCad.AutoRefresh := True; RefreshCAD_T(PCad, true); end; procedure TF_CADObjectView.cbZoomScaleCloseUp(Sender: TObject); var Ch: Char; begin cbZoomScale.Text := cbZoomScale.Items[cbZoomScale.ItemIndex]; Ch := #13; cbZoomScaleKeyPress(Sender, Ch); end; procedure TF_CADObjectView.VerScrollScroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer); begin if ScrollCode = scEndScroll then Set_PCad_VerScroll; PCad.SetFocus; end; procedure TF_CADObjectView.HorScrollScroll(Sender: TObject; ScrollCode: TScrollCode; var ScrollPos: Integer); begin if ScrollCode = scEndScroll then Set_PCad_HorScroll; PCad.SetFocus; end; function TF_CADObjectView.IfVisibleHorScrollBar: Boolean; var Client_Width: Integer; Page: TRect; begin Result := False; try Client_Width := PCad.ClientWidth; Page := PCad.GetPageRect; if (Page.Left < 0) or (Page.Right > Client_Width) then Result := True else Result := False; except on E: Exception do addExceptionToLogEx('TF_CADObjectView.IfVisibleHorScrollBar', E.Message); end; end; function TF_CADObjectView.IfVisibleVerScrollBar: Boolean; var Client_Height: Integer; Page: TRect; begin Result := False; try Client_Height := PCad.ClientHeight; Page := PCad.GetPageRect; if (Page.Top < 0) or (Page.Bottom > Client_Height) then Result := True else Result := False; except on E: Exception do addExceptionToLogEx('TF_CADObjectView.IfVisibleVerScrollBar', E.Message); end; end; Function TF_CADObjectView.GetMaxScrollsPosition: TPoint; var Page: TRect; PageX, PageY: Integer; ClientX, ClientY: Integer; begin Result := Point(0, 0); Page := PCad.GetPageRect; PageX := abs(Page.Right - Page.Left); PageY := abs(Page.Bottom - page.Top); ClientX := PCad.ClientWidth; ClientY := PCad.ClientHeight; Result.x := PageX - ClientX + 59; Result.y := PageY - ClientY + 59; end; Function TF_CADObjectView.GetPageSizesScrolls: TPoint; var Page: TRect; PageX, PageY: Integer; ClientX, ClientY: Integer; begin try Result := Point(0, 0); Page := PCad.GetPageRect; PageX := abs(Page.Right - Page.Left); PageY := abs(Page.Bottom - page.Top); ClientX := PCad.ClientWidth; ClientY := PCad.ClientHeight; Result.x := Round(ClientX / PageX * 100); Result.y := Round(ClientY / PageY * 100); except on E: Exception do addExceptionToLogEx('TF_CADObjectView.GetPageSizesScrolls', E.Message); end; end; procedure TF_CADObjectView.Set_PCad_HorScroll; var Koef_ScrollPos_X: Double; MaxCADScroll_X: Integer; SetScrollPos_X: Integer; begin // позиция CAD MaxCADScroll_X := GetMaxScrollsPosition.X; // Sets if (HorScroll.Max - HorScroll.PageSize) > 0 then begin Koef_ScrollPos_X := HorScroll.Position / (HorScroll.Max - HorScroll.PageSize); SetScrollPos_X := round(MaxCADScroll_X * Koef_ScrollPos_X); PCad.SetHScrollPosition(SetScrollPos_X, True); end; end; procedure TF_CADObjectView.Set_PCad_VerScroll; var Koef_ScrollPos_Y: Double; MaxCADScroll_Y: Integer; SetScrollPos_Y: Integer; begin // позиция CAD MaxCADScroll_Y := GetMaxScrollsPosition.Y; // Sets if (VerScroll.Max - VerScroll.PageSize) > 0 then begin Koef_ScrollPos_Y := VerScroll.Position / (VerScroll.Max - VerScroll.PageSize); SetScrollPos_Y := round(MaxCADScroll_Y * Koef_ScrollPos_Y); PCad.SetVScrollPosition(SetScrollPos_Y, True); end; end; Procedure TF_CADObjectView.Set_SCS_HorScroll; var MaxCADScroll_X: Integer; CurScrollPos_X: Integer; begin try // позиция CAD CurScrollPos_X := PCad.HSCBarPosition; MaxCADScroll_X := GetMaxScrollsPosition.X; // Sets HorScroll.PageSize := GetPageSizesScrolls.X; if MaxCADScroll_X > 0 then begin HorScroll.Position := round(CurScrollPos_X / MaxCADScroll_X * (HorScroll.Max - HorScroll.PageSize + 1)); try if Self.Visible then PCad.SetFocus; except end; end; except on E: Exception do addExceptionToLogEx('TF_CADObjectView.Set_SCS_HorScroll', E.Message); end; end; Procedure TF_CADObjectView.Set_SCS_VerScroll; var MaxCADScroll_Y: Integer; CurScrollPos_Y: Integer; begin try // позиция CAD CurScrollPos_Y := PCad.VSCBarPosition; MaxCADScroll_Y := GetMaxScrollsPosition.Y; // Sets pos VerScroll.PageSize := GetPageSizesScrolls.Y; if MaxCADScroll_Y > 0 then begin VerScroll.Position := round(CurScrollPos_Y / MaxCADScroll_Y * (VerScroll.Max - VerScroll.PageSize + 1)); try if self.Visible then PCad.SetFocus; except end; end; except on E: Exception do addExceptionToLogEx('TF_CADObjectView.Set_SCS_VerScroll', E.Message); end; end; function TF_CADObjectView.GetScaleKoefs: TDoublePoint; var pt: TPoint; VisRect: TDoubleRect; Rect: TRect; MPos: TDoublePoint; koefposx, koefposy: double; x1, x2, y1, y2: double; begin try Result.x := 0; Result.y := 0; Rect := PCad.ClientRect; x1 := Rect.Left; x2 := Rect.Right; y1 := Rect.Top; y2 := Rect.Bottom; if FScaleByCursor then begin GetCursorPos(pt); pt := Self.ScreenToClient(pt); Result.x := pt.x; Result.y := pt.y; end else begin Result.x := (x2 - x1) / 2; Result.y := (y2 - y1 - 10) / 2; end; except on E: Exception do addExceptionToLogEx('TF_CADObjectView.GetScaleKoefs', E.Message); end; end; Procedure TF_CADObjectView.ChangeScrollsOnChangeListSize; begin try PCad.AutoRefresh := False; //PCad.SetHScrollPosition(FCurrPCadScrollX, False); //PCad.SetVScrollPosition(FCurrPCadScrollY, False); // Гориз. скролл есть if IfVisibleHorScrollBar then begin HorScroll.Visible := True; Set_SCS_HorScroll; end else HorScroll.Visible := False; // Вертик. скролл есть if ifVisibleVerScrollBar then begin VerScroll.Visible := True; Set_SCS_VerScroll; end else VerScroll.Visible := False; // подредактировать скролбары // только гориз. if IfVisibleHorScrollBar and not ifVisibleVerScrollBar then if HorScroll.Width <> (PCad.Width - 7) then HorScroll.Width := PCad.Width - 7; // только вертик. if not IfVisibleHorScrollBar and ifVisibleVerScrollBar then if VerScroll.Height <> (PCad.Height - 7) then VerScroll.Height := PCad.Height - 7; // оба if IfVisibleHorScrollBar and ifVisibleVerScrollBar then begin if HorScroll.Width <> (PCad.Width - 15 - 7) then HorScroll.Width := PCad.Width - 15 - 7; if VerScroll.Height <> (PCad.Height - 15 - 7) then VerScroll.Height := PCad.Height - 15 - 7; end; PCad.AutoRefresh := True; SetZoomScale(Pcad.ZoomScale); RefreshCAD_T(PCad, true); except on E: Exception do addExceptionToLogEx('TF_CADObjectView.ChangeScrollsOnChangeListSize', E.Message); end; end; procedure TF_CADObjectView.PCadScaleChanged(Sender: TObject); var NewScrollPosX: Double; NewScrollPosY: Double; SetScrollPosX: Integer; SetScrollPosY: Integer; NewZoomScale: Integer; CalcedZoomKoef: Double; CalcedZoomDelta: Double; Koefs: TDoublePoint; begin try // Гориз. скролл есть NewZoomScale := PCad.ZoomScale; CalcedZoomKoef := (GSavedZoomScale / NewZoomScale); CalcedZoomDelta := (NewZoomScale - GSavedZoomScale); Koefs := GetScaleKoefs; if IfVisibleHorScrollBar then begin // CORRECT!!! if PCad.SelectedCount = 0 then begin if (GSavedScrollPosX <> -1) then begin SetScrollPosX := Round(GSavedScrollPosX / CalcedZoomKoef + Koefs.x / GSavedZoomScale * CalcedZoomDelta); PCad.SetHScrollPosition(SetScrollPosX, PCad.AutoRefresh); end; end; HorScroll.Visible := True; Set_SCS_HorScroll; end else HorScroll.Visible := False; // Вертик. скролл есть if ifVisibleVerScrollBar then begin if PCad.SelectedCount = 0 then begin if (GSavedScrollPosY <> -1) then begin SetScrollPosY := Round(GSavedScrollPosY / CalcedZoomKoef + Koefs.y / GSavedZoomScale * CalcedZoomDelta); PCad.SetVScrollPosition(SetScrollPosY, PCad.AutoRefresh); end; end; VerScroll.Visible := True; Set_SCS_VerScroll; end else VerScroll.Visible := False; // подредактировать скролбары // только гориз. if IfVisibleHorScrollBar and not ifVisibleVerScrollBar then if HorScroll.Width <> (PCad.Width - 7) then HorScroll.Width := PCad.Width - 7; // только вертик. if not IfVisibleHorScrollBar and ifVisibleVerScrollBar then if VerScroll.Height <> (PCad.Height - 7) then VerScroll.Height := PCad.Height - 7; // оба if IfVisibleHorScrollBar and ifVisibleVerScrollBar then begin if HorScroll.Width <> (PCad.Width - 15 - 7) then HorScroll.Width := PCad.Width - 15 - 7; if VerScroll.Height <> (PCad.Height - 15 - 7) then VerScroll.Height := PCad.Height - 15 - 7; end; except on E: Exception do addExceptionToLogEx('TF_CAD.PCadScaleChanged', E.Message); end; end; procedure TF_CADObjectView.PCadKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); begin if (ssCtrl in Shift) and (Key in [48,96]) then //22.09.2011 SetZoomScale(100); end; end.