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

📄 main.pas

📁 FlexGraphics是一套创建矢量图形的VCL组件
💻 PAS
📖 第 1 页 / 共 5 页
字号:
   Randomize;
   Shift.X := Round(Random * 2*Shift.X) - Shift.X;
   Shift.Y := Round(Random * 2*Shift.Y) - Shift.Y;
   SelList := TList.Create;
   for i:=0 to SelectedCount-1 do SelList.Add(Selected[i]);
  end;
  Duplicate(Shift.X, Shift.Y);
  if Assigned(SelList) then begin
   BeginSelectionUpdate;
   try
    UnselectAll;
    for i:=0 to SelList.Count-1 do Select(TFlexControl(SelList[i]));
   finally
    EndSelectionUpdate;
   end;
  end;
 finally
  SelList.Free;
 end;
end;

procedure TEditMainForm.acHelpAboutExecute(Sender: TObject);
begin
 ShowAbout;
end;

procedure TEditMainForm.acTranslateRotateCWExecute(Sender: TObject);
begin
 if Assigned(ActiveFlex) then ActiveFlex.Rotate(-90, False);
end;

procedure TEditMainForm.acTranslateRotateCCWExecute(Sender: TObject);
begin
 if Assigned(ActiveFlex) then ActiveFlex.Rotate(90, False);
end;

procedure TEditMainForm.acTranslateFlipHorzExecute(Sender: TObject);
begin
 if Assigned(ActiveFlex) then ActiveFlex.Rotate(0, True);
end;

procedure TEditMainForm.acTranslateFlipVerticalExecute(Sender: TObject);
begin
 if Assigned(ActiveFlex) then ActiveFlex.Rotate(180, True);
end;

procedure TEditMainForm.acGridShowExecute(Sender: TObject);
begin
 EditOptions.ShowGrid := not EditOptions.ShowGrid;
 UpdateAllOptions;
 CheckTools;
end;

procedure TEditMainForm.acGridPixelShowExecute(Sender: TObject);
begin
 EditOptions.ShowPixGrid := not EditOptions.ShowPixGrid;
 UpdateAllOptions;
 CheckTools;
end;

procedure TEditMainForm.acGridSnapExecute(Sender: TObject);
begin
 EditOptions.SnapToGrid := not EditOptions.SnapToGrid;
 UpdateAllOptions;
 CheckTools;
end;

procedure TEditMainForm.acLayerToFrontExecute(Sender: TObject);
var Index: integer;
begin
 if Assigned(ActiveFlex) then with ActiveFlex do begin
  Index := Layers.IndexOf(ActiveLayer);
  if Index < Layers.Count-1 then Layers.ChangeOrder(Index, Index+1);
 end;
end;

procedure TEditMainForm.acLayerToBackExecute(Sender: TObject);
var Index: integer;
begin
 if Assigned(ActiveFlex) then with ActiveFlex do begin
  Index := Layers.IndexOf(ActiveLayer);
  if Index > 0 then Layers.ChangeOrder(Index, Index-1);
 end;
end;

procedure TEditMainForm.acFileExitExecute(Sender: TObject);
begin
 Close;
end;

procedure TEditMainForm.acDebugPointsExecute(Sender: TObject);
begin
 {$IFDEF DEBUG_POINTS}
 ShowPointsDebug;
 {$ENDIF}
end;

procedure TEditMainForm.acCurveJoinExecute(Sender: TObject);
begin
 if not Assigned(ActiveFlex) then exit;
 ActiveFlex.EditPoints(pfJoin);
 CheckTools;
end;

procedure TEditMainForm.acCurveBreakExecute(Sender: TObject);
begin
 if not Assigned(ActiveFlex) then exit;
 ActiveFlex.EditPoints(pfBreak);
 CheckTools;
end;

procedure TEditMainForm.acCurveCloseExecute(Sender: TObject);
begin
 if not Assigned(ActiveFlex) then exit;
 ActiveFlex.EditPoints(pfClose);
 CheckTools;
end;

procedure TEditMainForm.acCurveToLineExecute(Sender: TObject);
begin
 if not Assigned(ActiveFlex) then exit;
 ActiveFlex.EditPoints(pfToLine);
 CheckTools;
end;

procedure TEditMainForm.acCurveToCurveExecute(Sender: TObject);
begin
 if not Assigned(ActiveFlex) then exit;
 ActiveFlex.EditPoints(pfToCurve);
 CheckTools;
end;

procedure TEditMainForm.acCurveFlattenExecute(Sender: TObject);
begin
 if not Assigned(ActiveFlex) then exit;
 with ActiveFlex do FlattenSelected((Scale/100) * (1/PixelScaleFactor));
 CheckTools;
end;

procedure TEditMainForm.acCurveBreakApartExecute(Sender: TObject);
begin
 if not Assigned(ActiveFlex) then exit;
 ActiveFlex.BreakApartSelected;
 CheckTools;
end;

procedure TEditMainForm.acCurveCombineExecute(Sender: TObject);
begin
 if not Assigned(ActiveFlex) then exit;
 ActiveFlex.CombineSelected;
 CheckTools;
end;

procedure TEditMainForm.acCurveConvertToCurveExecute(Sender: TObject);
begin
 if not Assigned(ActiveFlex) then exit;
 ActiveFlex.ConvertSelectedToCurves;
end;

procedure TEditMainForm.acGridOptionsExecute(Sender: TObject);
begin
 ViewOptionsExecute(opGrid);
end;

procedure TEditMainForm.RefreshColors;
var i, j, Color: integer;
    s: string;
    ARows, ACols: integer;
begin
 FColors.Clear;
 // Add transparent color
 FColors.Add(pointer(clNone));
 // Add default colors
 for i:=Low(DefaultPalette) to High(DefaultPalette) do
  FColors.Add(pointer(ColorToRGB(DefaultPalette[i])));
 // Add custom colors
 for i:=0 to CustomColors.Count-1 do begin
  s := CustomColors[i];
  j := Pos('=', s);
  if j = 0 then continue;
  Color := StrToIntDef('$' + copy(s, j+1, Length(s)-j), -1);
  if Color = -1 then continue;
  FColors.Add(pointer(ColorToRGB(Color)));
 end;
 // Add default (color edit) color
 FColors.Add(pointer(clDefault));
 // Rebuild color grid
 with dgColors do begin
  RowCount := FColors.Count;
  i := (DefaultRowHeight + GridLineWidth);
  if i > 0
   then ARows := Height div i
   else ARows := 0;
  if ARows > 0
   then ACols := FColors.Count div ARows + byte(FColors.Count mod ARows <> 0)
   else ACols := 0;
  RowCount := ARows;
  ColCount := ACols;
  Invalidate;
 end;
end;

procedure TEditMainForm.CustomColorsChange(Sender: TObject);
begin
 RefreshColors;
end;

procedure TEditMainForm.dgColorsDrawCell(Sender: TObject; ACol,
  ARow: Integer; Rect: TRect; State: TGridDrawState);
var Index: integer;
    Color: TColor;
begin
 Index := ACol * dgColors.RowCount + ARow;
 with dgColors.Canvas do begin
  if Index < FColors.Count then begin
   Pen.Color := clBlack;
   Pen.Style := psSolid;
   Brush.Style := bsClear;
   {$IFDEF VER120} // {FG_D4}
   Rectangle(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom);
   {$ELSE}
   Rectangle(Rect);
   {$ENDIF}
   InflateRect(Rect, -1, -1);
   Color := TColor(FColors[Index]);
   case Color of
    clNone:
      with Rect do begin
       Brush.Color := clWhite;
       Brush.Style := bsSolid;
       FillRect(Rect);
       MoveTo(Left, Top);
       LineTo(Right, Bottom);
       MoveTo(Right, Top-1);
       LineTo(Left-1, Bottom);
      end;
    clDefault:
      begin
       Brush.Color := clWhite;
       Brush.Style := bsSolid;
       FillRect(Rect);
       InflateRect(Rect, -4, 0);
       dec(Rect.Bottom, 2);
       Rect.Top := Rect.Bottom - 2;
       Brush.Color := clBlack;
       FillRect(Rect);
      end;
    else
      begin
       Brush.Color := ColorToRGB(Color);
       Brush.Style := bsSolid;
       FillRect(Rect);
      end;
   end;
  end;
 end;
end;

procedure TEditMainForm.panColorsResize(Sender: TObject);
begin
 RefreshColors;
end;

procedure TEditMainForm.sptColorsMoved(Sender: TObject);
begin
 RefreshColors;
end;

procedure TEditMainForm.dgColorsMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var Flex: TFlexPanel;
    Index, i: integer;
    ACol, ARow: integer;
    Color: TColor;
    Control: TFlexControl;
    Brush: TBrushProp;
    Pen: TPenProp;
    {$IFDEF USE_FLEXPLUS}
    BrushPlus: TBrushPlusProp;
    PenPlus: TPenPlusProp;
    {$ENDIF}
    PassRec: TPassControlRec;
begin
 dgColors.MouseToCell(X, Y, ACol, ARow);
 Index := ACol * dgColors.RowCount + ARow;
 if (Index >= 0) and (Index < FColors.Count)
  then Color := TColor(FColors[Index])
  else exit;
 Flex := ActiveFlex;
 if not Assigned(Flex) or (Flex.SelectedCount = 0) then exit;
 if Color = clDefault then begin
  // Define initial color
  Color := clBlack;
  for i:=0 to Flex.SelectedCount-1 do begin
   Control := Flex.Selected[i];
   FirstControl(Control, PassRec);
   while Assigned(Control) do begin
    Brush := Control.Props['Brush'] as TBrushProp;
    Pen := Control.Props['Pen'] as TPenProp;
    if (Button = mbLeft) and Assigned(Brush) and
      (Brush.Method = bmHatch) then begin
     // Get color
     Color := Brush.Color;
     if Brush.Style <> bsClear then break;
    end else
    if (Button = mbRight) and Assigned(Pen) then begin
     Color := Pen.Color;
     if Pen.Style <> psClear then break;
    end;
    {$IFDEF USE_FLEXPLUS}
    if not Assigned(Brush) then begin
     BrushPlus := Control.Props['BrushPlus'] as TBrushPlusProp;
     if (Button = mbLeft) and Assigned(BrushPlus) and
        (BrushPlus.Method in [bpmClear, bpmSolid, bpmHatch]) then begin
      // Get color
      Color := BrushPlus.Color;
      if (Color <> clNone) and (BrushPlus.Method <> bpmClear) then break;
     end;
    end;
    if not Assigned(Pen) then begin
     PenPlus := Control.Props['PenPlus'] as TPenPlusProp;
     if (Button = mbRight) and Assigned(PenPlus) then begin
      // Get color
      Color := PenPlus.Color;
      if (Color <> clNone) and (PenPlus.Method <> ppmClear) then break;
     end;
    end;
    {$ENDIF}
    // Next sub-control
    Control := NextControl(PassRec);
   end;
   ClosePassRec(PassRec);
  end;
  cd_Palette.Color := Color;
  // Update custom colors
  cd_Palette.CustomColors.Assign(CustomColors);
  if cd_Palette.Execute then begin
   CustomColors.Assign(cd_Palette.CustomColors);
   Color := cd_Palette.Color;
  end else
   exit;
 end;
 Flex.History.BeginPanelGroup(TPanelColorHistoryGroup);
 try
  for i:=0 to Flex.SelectedCount-1 do begin
   Control := Flex.Selected[i];
   FirstControl(Control, PassRec);
   while Assigned(Control) do begin
    Brush := Control.Props['Brush'] as TBrushProp;
    Pen := Control.Props['Pen'] as TPenProp;
    if (Button = mbLeft) and Assigned(Brush) then begin
     // Fill
     Brush.Method := bmHatch;
     if Color = clNone then
      Brush.Style := bsClear
     else begin
      Brush.Style := bsSolid;
      Brush.Color := ColorToRGB(Color);
     end;
    end else
    if (Button = mbRight) and Assigned(Pen) then begin
     // Outline
     if Color = clNone then
      Pen.Style := psClear
     else begin
      Pen.Style := psSolid;
      Pen.Color := ColorToRGB(Color);
     end;
    end;
    {$IFDEF USE_FLEXPLUS}
    if not Assigned(Brush) then begin
     BrushPlus := Control.Props['BrushPlus'] as TBrushPlusProp;
     if (Button = mbLeft) and Assigned(BrushPlus) then begin
      // Fill
      if Color = clNone then
       BrushPlus.Method := bpmClear
      else begin
       BrushPlus.Method := bpmSolid;
       BrushPlus.Color := Color;
      end;
     end;
    end;
    if not Assigned(Pen) then begin
     PenPlus := Control.Props['PenPlus'] as TPenPlusProp;
     if (Button = mbRight) and Assigned(PenPlus) then begin
      // Outline
      if Color = clNone then
       PenPlus.Method := ppmClear
      else begin
       PenPlus.Method := ppmDash;
       PenPlus.Color := Color;
      end;
     end;
    end;
    {$ENDIF}
    // Next sub-control
    Control := NextControl(PassRec);
   end;
   ClosePassRec(PassRec);
  end;
 finally
  Flex.History.EndPanelGroup(TPanelColorHistoryGroup);
 end;
end;

procedure TEditMainForm.acEditUndoExecute(Sender: TObject);
begin
 if not Assigned(ActiveFlex) then exit;
 ActiveFlex.History.Undo;
 CheckTools;
 {$IFDEF DEBUG_HISTORY}
 if Assigned(fmHistoryDebug) then
   fmHistoryDebug.HistoryChange(ActiveFlex.History);
 {$ENDIF} 
end;

procedure TEditMainForm.acEditRedoExecute(Sender: TObject);
begin
 if not Assigned(ActiveFlex) then exit;
 ActiveFlex.History.Redo;
 CheckTools;
 {$IFDEF DEBUG_HISTORY}
 if Assigned(fmHistoryDebug) then
   fmHistoryDebug.HistoryChange(ActiveFlex.History);
 {$ENDIF}
end;

procedure TEditMainForm.acDebugHistoryExecute(Sender: TObject);
begin
 {$IFDEF DEBUG_HISTORY}
 if not Assigned(fmHistoryDebug) then
  fmHistoryDebug := TfmHistoryDebug.Create(Application);
 fmHistoryDebug.Flex := ActiveFlex;
 fmHistoryDebug.Show;
 {$ENDIF}
end;

end.

⌨️ 快捷键说明

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