⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 main.pas

📁 FlexGraphics是一套创建矢量图形的VCL组件
💻 PAS
📖 第 1 页 / 共 5 页
字号:
   TColor($C0C0C0),
   TColor($0000FF),
   TColor($00FF00),
   TColor($00FFFF),
   TColor($FF0000),
   TColor($FF00FF),
   TColor($FFFF00),
   TColor($400000),
   TColor($A00000),
   TColor($004000),
   TColor($404000),
   TColor($804000),
   TColor($408000),
   TColor($C08000),
   TColor($FF8000),
   TColor($40FF00),
   TColor($80FF00),
   TColor($000040),
   TColor($400040),
   TColor($800040),
   TColor($400080),
   TColor($FF0080),
   TColor($004080),
   TColor($404080),
   TColor($C08080),
   TColor($FF8080),
   TColor($00FF80),
   TColor($80FF80),
   TColor($FFFF80),
   TColor($8000FF),
   TColor($0080FF),
   TColor($4080FF),
   TColor($8080FF),
   TColor($C080FF),
   TColor($FF80FF),
   TColor($80FFFF)
  );

procedure TEditMainForm.FormCreate(Sender: TObject);
var List: TStringList;
    i, Index: integer;
    Item: TMenuItem;
begin
 FIniting := true;
 LoadFlexCursors;
 RegisterExternalControls;
 // Insert all toolbars to main menu
 FToolbarItems := TList.Create;
 List := TStringList.Create;
 try
  // Collect all toolbars
  for i:=0 to ComponentCount-1 do
   if Components[i] is TTBToolbar then
    List.AddObject(TTBToolbar(Components[i]).Caption, Components[i]);
  if List.Count > 0 then begin
   // Sort by captions
   List.Sort;
   // Place to main menu
   Index := miView.IndexOf(miToolBarsDelimiter);
   if Index < 0 then Index := 0;
   for i:=List.Count-1 downto 0 do begin
    Item := TMenuItem.Create(miView);
    Item.OnClick := ToolbarItemClick;
    Item.Caption := List[i];
    Item.Tag := integer(List.Objects[i]);
    miView.Insert(Index, Item);
    FToolbarItems.Add(Item);
   end;
  end else
   // No toolbars: Hide delimiter in main menu
   miToolBarsDelimiter.Visible := false;
 finally
  List.Free;
 end;
 {$IFDEF DEBUG_HISTORY}
 fmHistoryDebug := TfmHistoryDebug.Create(Self);
 fmHistoryDebug.BorderStyle := bsSizeToolWin;
 fmHistoryDebug.Align := alBottom;
 fmHistoryDebug.Parent := Self;
 fmHistoryDebug.Height := 200;
 fmHistoryDebug.sbrMain.Visible := false;
 fmHistoryDebug.Visible := true;
 {$ENDIF}
 // Setup custom color change event
 FColors := TList.Create;
 CustomColors.OnChange := CustomColorsChange;
 RefreshColors;
 CheckToolbars;
end;

procedure TEditMainForm.FormDestroy(Sender: TObject);
begin
 CustomColors.OnChange := Nil;
 FColors.Free;
 FToolbarItems.Free;
end;

procedure TEditMainForm.FormShow(Sender: TObject);
var Tlw1, Tlw2: TTBToolWindow;
begin
 if FIniting then begin
  // Show Inspector
  Tlw1 := CreateToolWindow(fmLayers, tdDockRight);
  // Show layer manager
  Tlw2 := CreateToolWindow(fmInspector, Nil);
  // Arrange
  if Assigned(Tlw2) then Tlw2.CurrentDock := tdDockRight;
  if Assigned(Tlw1) then Tlw1.DockPos := Tlw1.DockPos + Tlw1.Height - 110;
  // Init
  fmLibrary.OnLibChange := ActiveLibChange;
  FIniting := False;
  CheckTools;
 end;
end;

procedure TEditMainForm.RegisterExternalControls;
var i: integer;
    B: TBitmap;
    TBItem: TTBItem;
    Hint: string;
begin
 if Length(RegisteredFlexControls) = 0 then exit;
 B := TBitmap.Create;
 try
  B.Width := imgToolIcons.Width;
  B.Height := imgToolIcons.Height;
  for i:=0 to High(RegisteredFlexControls) do begin
   FillRect(B.Canvas.Handle, Rect(0, 0, B.Width, B.Height),
     GetStockObject(WHITE_BRUSH) );
   Hint := '';
   if not RegisteredFlexControls[i].GetToolInfo(B, Hint) then continue;
   tbrTools.Images.AddMasked(B, B.TransparentColor);
   TBItem := TTBItem.Create(Self);
   TBItem.ImageIndex := tbrTools.Images.Count-1;
   TBItem.GroupIndex := 1;
   TBItem.Hint := Hint;
   TBItem.Tag := integer(RegisteredFlexControls[i]);
   TBItem.OnClick := tbtToolClick;
   tbrTools.Items.Add(TBItem);
  end;
 finally
  B.Free;
 end;
end;

procedure TEditMainForm.tbtToolClick(Sender: TObject);
var i: integer;
begin
 if Sender is TTBCustomItem then
  TTBCustomItem(Sender).Checked := true;
 for i:=0 to MDIChildCount-1 do
  with (MDIChildren[i] as TFlexChildForm).Flex do
  if Sender = tbtZoomTool then begin
   EditPointControl := Nil;
   CreatingControlClass := Nil;
   ToolMode := ftmZoom;
  end else
  if Sender = tbtPanTool then begin
   //EditPointControl := Nil;
   CreatingControlClass := Nil;
   ToolMode := ftmPan;
  end else
  if Sender = tbtShapeTool then begin
   CreatingControlClass := Nil;
   //if SelectedCount = 1 then EditPointControl := Selected[0];
   ToolMode := ftmPointEdit;
  end else begin
   if Sender = tbtArrowTool then begin
    CreatingControlClass := Nil;
    //EditPointControl := Nil;
   end else
   if Sender = tbtPolyLineTool then
    CreatingControlClass := TFlexCurve
   else
   if Sender = tbtPolygonTool then
    CreatingControlClass := TFlexRegularPolygon
   else
   if Sender = tbtConnectorTool then
    CreatingControlClass := TFlexConnector
   else
   if Sender = tbtRectTool then
    CreatingControlClass := TFlexBox
   else
   if Sender = tbtEllipseTool then
    CreatingControlClass := TFlexEllipse
   else
   if Sender = tbtTextTool then
    CreatingControlClass := TFlexText
   else
   if Sender = tbtPictureTool then
    CreatingControlClass := TFlexPicture
   else
   if TTBCustomItem(Sender).Tag <> 0 then
    CreatingControlClass := TFlexControlClass(TTBCustomItem(Sender).Tag);
   //if ToolMode in [ftmZoom, ftmZooming, ftmPan, ftmPanning] then
    ToolMode := ftmSelect;
  end;
 CheckTools;
end;

procedure TEditMainForm.ToolbarItemClick(Sender: TObject);
var i: integer;
    Item: TMenuItem;
    ToolBar: TTBToolbar;
begin
 for i:=0 to FToolbarItems.Count-1 do begin
  Item := TMenuItem(FToolbarItems[i]);
  if Item <> Sender then continue;
  ToolBar := TTBToolbar(Item.Tag);
  ToolBar.Visible := not ToolBar.Visible;
  break;
 end;
 CheckToolbars;
end;

procedure TEditMainForm.CheckToolbars;
var i: integer;
    Item: TMenuItem;
    ToolBar: TTBToolbar;
begin
 for i:=0 to FToolbarItems.Count-1 do begin
  Item := TMenuItem(FToolbarItems[i]);
  ToolBar := TTBToolbar(Item.Tag);
  Item.Checked := ToolBar.Visible;
 end;
end;

procedure TEditMainForm.tbrStdToolsClose(Sender: TObject);
begin
 CheckToolbars;
end;

procedure TEditMainForm.CheckToolButtons(Sender: TObject);
begin
 if Sender <> ActiveFlex then exit;
 with TFlexPanel(Sender) do
 case ToolMode of
  ftmSelect:
    if not Assigned(CreatingControlClass) then tbtArrowTool.Click;
  ftmPan:
    tbtPanTool.Click;
 end;
end;

procedure TEditMainForm.CheckTools;
var Flex: TFlexPanel;
    IsDoc, IsSel, IsSelMany, IsModified: boolean;
    IsSelGroup, IsSelCurve, IsLib, IsChecked: boolean;
    IsSelAllCurves: boolean;
    IsLastLayer, IsFirstLayer: boolean;
    SelCount, i, FigCount: integer;
    CurveCaps: TPathEditFuncs;

 function GetHistoryCaption(const Ident: string; Index: integer): string;
 var Action: THistoryAction;
 begin
  if Assigned(Flex) and
     (Index >= 0) and (Index < Flex.History.ActionCount) then begin
   Action := Flex.History[Index];
   while (Action is THistoryGroup) and
     (THistoryGroup(Action).ActionCount = 1) do
    Action := THistoryGroup(Action).Actions[0];
   Result := Ident + ' "' + Action.Caption + '"';
  end else
   Result := Ident;
 end;

begin
 Flex := ActiveFlex;
 // Flags
 if Assigned(Flex) then with Flex do begin
  IsDoc := True;
  SelCount := SelectedCount;
  IsSel := SelCount > 0;
  IsSelMany := SelCount > 1;
  //IsSelGroup := (SelCount = 1) and (Selected[0] is TFlexGroup);
  IsSelGroup := false;
  for i:=0 to SelCount-1 do begin
   IsSelGroup := Selected[i].IsUngroupable;
   if IsSelGroup then break;
  end;
  IsSelCurve := (SelCount = 1) and (Selected[0].PointCount > 0);
  if IsSelCurve {and Flex.IsEditPointsVisible} then begin
   if Flex.IsEditPointsVisible
    then CurveCaps := Flex.EditPointsCaps
    else CurveCaps := [];
   FigCount := Length(Selected[0].PointsInfo.Figures);
  end else begin
   CurveCaps := [];
   FigCount := 0;
  end;
  IsSelAllCurves := true;
  for i:=0 to SelCount-1 do
   if Selected[i].PointCount = 0 then begin
    IsSelAllCurves := false;
    break;
   end;
  IsModified := Flex.Modified;
  FActiveFlexModified := Flex.Modified;
  IsLastLayer := Layers.IndexOf(ActiveLayer) = Layers.Count-1;
  IsFirstLayer := Layers.IndexOf(ActiveLayer) = 0;
  acLayerDelete.Enabled := cbActiveLayer.Items.Count > 1;
  acSchemeDelete.Enabled := cbActiveScheme.Items.Count > 1;
 end else begin
  IsDoc := False;
  IsSel := False;
  IsSelMany := False;
  IsSelGroup := False;
  IsSelAllCurves := False;
  IsSelCurve := False;
  CurveCaps := [];
  FigCount := 0;
  IsModified := False;
  IsLastLayer := False;
  IsFirstLayer := False;
  cbActiveLayer.Clear;
  cbActiveScheme.Clear;
  acLayerDelete.Enabled := False;
  acSchemeDelete.Enabled := False;
  FActiveFlexModified := false;
 end;
 IsLib := Assigned(fmLibrary) and Assigned(fmLibrary.ActiveLibrary);
 IsChecked := false;
 // Draw tools
 for i:=0 to tbrTools.Items.Count-1 do with tbrTools.Items[i] do begin
  Enabled := IsDoc;
  if not IsDoc then
   Checked := False
  else
  if Checked then
   IsChecked := true;
 end;
 if IsDoc and not IsChecked then tbtArrowTool.Checked := true;
 // Grid
 acGridShow.Checked := EditOptions.ShowGrid;
 acGridPixelShow.Checked := EditOptions.ShowPixGrid;
 acGridSnap.Checked := EditOptions.SnapToGrid;
 // Dockers
 acDockerInspector.Checked := Assigned(FindToolParentContainer(fmInspector));
 acDockerLibrary.Checked := Assigned(FindToolParentContainer(fmLibrary));
 acDockerUserData.Checked := Assigned(FindToolParentContainer(fmUserData));
 acDockerLayers.Checked := Assigned(FindToolParentContainer(fmLayers));
 acDockerPalette.Checked := panColors.Visible; 
 // Edit
 acEditDelete.Enabled := IsSel;
 acEditCut.Enabled := IsSel;
 acEditCopy.Enabled := IsSel;
 acEditDuplicate.Enabled := IsSel;
 acEditClone.Enabled := IsSel {and
   (IsSelMany or not (Flex.Selected[0] is TFlexClone))};
 acEditUndo.Enabled := IsDoc and (Flex.History.ActionIndex >= 0);
 acEditRedo.Enabled := IsDoc and (Flex.History.ActionCount > 0) and
   (Flex.History.ActionIndex < Flex.History.ActionCount - 1);
 if IsDoc then begin
  acEditUndo.Hint := GetHistoryCaption('Undo', Flex.History.ActionIndex);
  acEditRedo.Hint := GetHistoryCaption('Redo', Flex.History.ActionIndex +1);
 end else begin
  acEditUndo.Hint := 'Undo';
  acEditRedo.Hint := 'Redo';
 end;
 acLibItemAdd.Enabled := IsSel and IsLib;
 // Layout
 cbActiveLayer.Enabled := IsDoc;
 cbActiveScheme.Enabled := IsDoc;
 acLayerNew.Enabled := IsDoc;
 acSchemeNew.Enabled := IsDoc;
 acLayerToFront.Enabled := IsDoc and not IsLastLayer;
 acLayerToBack.Enabled := IsDoc and not IsFirstLayer;
 // File
 acFileProperties.Enabled := IsDoc;
 acFilePreview.Enabled := IsDoc and not Assigned(fmPreview);
 acFileSave.Enabled := IsDoc and IsModified;
 acFileSaveAs.Enabled := IsDoc;
 acFilePrint.Enabled := IsDoc;
 acFileExport.Enabled := IsDoc;
 // Arrange
 acArrangeForwardOne.Enabled := IsSel;
 acArrangeBackOne.Enabled := IsSel;
 acArrangeToFront.Enabled := IsSel;
 acArrangeToBack.Enabled := IsSel;
 acArrangeGroup.Enabled := IsSelMany;
 acArrangeUngroup.Enabled := IsSelGroup;
 // Translate
 acTranslateRotateCW.Enabled := IsSel;
 acTranslateRotateCCW.Enabled := IsSel;
 acTranslateFlipHorz.Enabled := IsSel;
 acTranslateFlipVertical.Enabled := IsSel;
 // Curve edit
 acCurveJoin.Enabled := pfJoin in CurveCaps;
 acCurveBreak.Enabled := pfBreak in CurveCaps;
 acCurveClose.Enabled := pfClose in CurveCaps;
 acCurveToLine.Enabled := pfToLine in CurveCaps;
 acCurveToCurve.Enabled := pfToCurve in CurveCaps;
 acCurveFlatten.Enabled := IsSelCurve and
   Flex.Selected[0].PointsInfo.IsCurve;
 acCurveBreakApart.Enabled := FigCount > 1;
 acCurveCombine.Enabled := IsSelMany and IsSelAllCurves;
 acCurveConvertToCurve.Enabled := IsSel;
 // Align
 acAlignLeft.Enabled := IsSelMany;
 acAlignHCenter.Enabled := IsSelMany;
 acAlignRight.Enabled := IsSelMany;
 acAlignTop.Enabled := IsSelMany;
 acAlignVCenter.Enabled := IsSelMany;
 acAlignBottom.Enabled := IsSelMany;
 acAlignCenter.Enabled := IsSelMany;
 // Zoom
 cbZoom.Enabled := IsDoc;
 if cbZoom.Enabled
  then cbZoom.Text := IntToStr(Flex.Scale)+'%'
  else cbZoom.Text := '';
 acZoomIn.Enabled := IsDoc and (Flex.Scale < MaxScale);
 acZoomOut.Enabled := IsDoc and (Flex.Scale > MinScale);
 acZoomActual.Enabled := IsDoc and (Flex.Scale <> 100);
end;

function TEditMainForm.CreateToolWindow(ToolForm: TCustomForm;
  DockTo: TTBDock): TTBToolWindow;
var Cont: TToolContainer;
begin
 if Assigned(DockTo) and (DockTo.ToolbarCount > 0) then begin
  Cont := FindChildContainer(DockTo.Toolbars[0]);
  if Assigned(Cont) then begin
   Cont.InsertTool(ToolForm);
   Cont.ActivePageForm := ToolForm;
   Result := Nil;
   exit;
  end;
 end;
 Result := TTBToolWindow.Create(Self);
 with Result do begin
  Caption := '';
  CloseButtonWhenDocked := True;
  Width := 206;
  Height := 300;
  FloatingPosition := Self.ClientToScreen(Point(50, 50));
  Stretch := True;
  MinClientWidth := 100;
  //BorderStyle := bsNone;
  DragHandleStyle := dhDouble;
  //OnDockChanged := TBToolWindow1DockChanged;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -