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

📄 main.pas

📁 小区水费管理系统源代码水费收费管理系统 水费收费管理系统
💻 PAS
📖 第 1 页 / 共 3 页
字号:
    Exit;
  end;

  if SkinObject.Owner = nil then
  begin
    FRoot := SkinObject;
    FSelected := SkinObject;
    FInspector.CurObj := SkinObject;
    UpdateSkin;
  end
  else
  begin
    Par := SkinObject;
    while Par.Owner <> nil do
      Par := (Par.Owner as TSeSkinObject);

    FRoot := Par;
    FSelected := SkinObject;
    FInspector.CurObj := SkinObject;
    UpdateSkin;
  end;

  Label6.Caption := SkinObject.Name + ': ';
  Label7.Caption := SkinObject.ClassName + ';';

  if FSelected <> nil then
    Panel1.Caption := ' Objects Tree - '+FSelected.Name;
  if FRoot = nil then
    Panel1.Caption := ' Objects Tree - Root';
end;

procedure TfrmMain.SelectBitmap(Bitmap: TSeBitmap);
var
  B: TBitmap;
begin
  ShowPanel(vImage);

  FSelectedBitmap := Bitmap;
  if Bitmap <> nil then
  begin
    B := TBitmap.Create;
    try
      B.Width := Bitmap.Width;
      B.Height := Bitmap.Height;

      Bitmap.Draw(B.Canvas.Handle, 0, 0);

      ImageView.Picture.Assign(B);

      Panel1.Caption := ' Objects Tree - '+Bitmap.Name;
    finally
      B.Free;
    end;
    FInspector.CurObj := nil;
  end;
end;

function TfrmMain.GetGripRect(GripKind: TGripKind): TRect;
begin
  Result := Rect(0, 0, 0, 0);

  if FSelected <> nil then
    with FSelected.BoundsRect do
    begin
      case GripKind of
        gkMove: Result := Rect((Left + Right) div 2 - GripSize, (Top + Bottom) div 2 - GripSize, (Left + Right) div 2 + GripSize, (Top + Bottom) div 2 + GripSize);
        gkTopLeft: Result := Rect(Left - GripSize, Top - GripSize, Left + GripSize, Top + GripSize);
        gkTopRight: Result := Rect(Right - GripSize, Top - GripSize, Right + GripSize, Top + GripSize);
        gkBottomLeft: Result := Rect(Left - GripSize, Bottom - GripSize, Left + GripSize, Bottom + GripSize);
        gkBottomRight: Result := Rect(Right - GripSize, Bottom - GripSize, Right + GripSize, Bottom + GripSize);
      end;
    end;
end;

procedure TfrmMain.WorkAreaMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  Grip: TGripKind;
  R: TRect;
  SkinObject: TSeSkinObject;
begin
  { Mouse down }
  X := Round(X / FScale);
  Y := Round(Y / FScale);

  if Button = mbLeft then
  begin
    { Start Dragging }
    if FSelected = nil then Exit;

    for Grip := Low(Grip) to High(Grip) do
    begin
      R := GetGripRect(Grip);
      if (not IsRectEmpty(R)) and PtInRect(R, Point(X, Y)) then
      begin
        FDragPoint := Point(X, Y);
        FDragging := true;
        FDragGrip := Grip;

        Exit;
      end
      else
        WorkArea.Cursor := crDefault;
    end;

    { Select object}
    if FRoot <> nil then
    begin
      SkinObject := FRoot.FindObjectByPoint(Point(X, Y));
      if SkinObject <> nil then
        SelectObject(SkinObject);
    end;
  end;
end;

procedure TfrmMain.WorkAreaMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
var
  Grip: TGripKind;
  R: TRect;
begin
  { Mouse move }
  X := Round(X / FScale);
  Y := Round(Y / FScale);

  if Shift = [] then
  begin
    for Grip := Low(Grip) to High(Grip) do
    begin
      R := GetGripRect(Grip);
      if (not IsRectEmpty(R)) and PtInRect(R, Point(X, Y)) then
      begin
        case Grip of
          gkMove: WorkArea.Cursor := crSizeAll;
          gkTopLeft: WorkArea.Cursor := crSizeNWSE;
          gkTopRight: WorkArea.Cursor := crSizeNESW;
          gkBottomLeft: WorkArea.Cursor := crSizeNESW;
          gkBottomRight: WorkArea.Cursor := crSizeNWSE;
        end;
        Break;
      end
      else
        WorkArea.Cursor := crDefault;
    end;
  end;

  if (Shift = [ssLeft]) and FDragging and (FSelected <> nil) and
     ((FDragPoint.X <> X) or (FDragPoint.Y <> Y)) then
  begin
    R := FSelected.BoundsRect;
    case FDragGrip of
      gkMove: begin
        { Moving }
        R := FSelected.BoundsRect;
        OffsetRect(R, X - FDragPoint.X, Y - FDragPoint.Y);
      end;
      gkTopLeft: begin
        { Resize - TopLeft grip }
        R.Left := R.Left + (X - FDragPoint.X);
        R.Top := R.Top + (Y - FDragPoint.Y);
      end;
      gkTopRight: begin
        { Resize - TopRight grip }
        R.Right := R.Right + (X - FDragPoint.X);
        R.Top := R.Top + (Y - FDragPoint.Y);
      end;
      gkBottomLeft: begin
        { Resize - BottomLeft grip }
        R.Left := R.Left + (X - FDragPoint.X);
        R.Bottom := R.Bottom + (Y - FDragPoint.Y);
      end;
      gkBottomRight: begin
        { Resize - BottomRight grip }
        R.Right := R.Right + (X - FDragPoint.X);
        R.Bottom := R.Bottom + (Y - FDragPoint.Y);
      end;
    end;
    FSelected.BoundsRect := R;
    FDragPoint := Point(X, Y);
    { Update }
    if (FSelected.Owner <> nil) and (FSelected.Owner is TSeSkinObject) then
      TSeSkinObject(FSelected.Owner).Aligning; 
    FRoot.Aligning;
    WorkAreaPaint(Self);
    FInspector.CurObj := nil;
    FInspector.CurObj := FSelected;

    FModified := true;
  end;
end;

procedure TfrmMain.WorkAreaMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  { Mouse Up }
  FDragging := false;
end;

procedure TfrmMain.WorkAreaPaint(Sender: TObject);
var
  Buffer: TSeBitmap;
  SrcRect, DstRect: TRect;
  R: TRect;
  BufferCanvas: TCanvas;
  Grip: TGripKind;
begin
  { Paint }
  if FRoot <> nil then
  begin
    if FRoot.Width * FRoot.Height = 0 then Exit;

    Buffer := TSeBitmap.Create;
    try
      Buffer.SetSize(FRoot.Width, FRoot.Height);
      Buffer.Blend := true;

      FRoot.State := ssDesign;
      FRoot.BoundsRect := Rect(0, 0, Buffer.Width, Buffer.Height);

      { Draw Selected Rect }
      if FSelected <> nil then
      begin
        BufferCanvas := TCanvas.Create;
        try
          BufferCanvas.Handle := Buffer.DC;

          FRoot.Draw(BufferCanvas);
         
          with BufferCanvas do
          begin
            { Draw rect }
            Brush.Style := bsClear;
            Pen.Mode := pmXor;
            Pen.Color := clSilver;
            Pen.Style := psDot;
	    with FSelected.BoundsRect do
              Rectangle(Left, Top, Right, Bottom);

            { Dra Grips }
            for Grip := Low(Grip) to high(Grip) do
            begin
              R := GetGripRect(Grip);
              Buffer.FillRect(R, ckRed);
              Buffer.DrawRect(R, ckYellow);
            end;
          end;
        finally
          BufferCanvas.Handle := 0;
          BufferCanvas.Free;
        end;
      end;

      { Draw }
      SrcRect := Rect(0, 0, Buffer.Width, Buffer.Height);
      DstRect := Rect(0, 0, Round(Buffer.Width * FScale), Round(Buffer.Height * FScale));
      Buffer.Draw(WorkArea.Canvas.Handle, DstRect, SrcRect);
    finally
      Buffer.Free;
    end;
  end
  else
  begin
    { Empty }
    WorkArea.Canvas.Pen.Style := psClear;
    WorkArea.Canvas.Brush.Color := clBtnFace;
    WorkArea.Canvas.Rectangle(0, 0, WorkArea.Width+1, WorkArea.Height+1);
  end;
end;

procedure TfrmMain.cbScaleChange(Sender: TObject);
begin
  case cbScale.ItemIndex of
    0: FScale := 1;
    1: FScale := 2;
    2: FScale := 4;
    3: FScale := 8;
  end;
  UpdateSkin;
end;

function TfrmMain.GetOwner: TSeSkinObject;
begin
  if (FSelected <> nil) then
    Result := FSelected
  else
    if (FRoot <> nil) then
      Result := FRoot
    else
      Result := nil;
end;

procedure TfrmMain.CreateSkinObject(ObjectClass: TSeSkinObjectClass);
var
  SkinObject: TSeSkinObject;
  S: string;
begin
  if FSkinSource = nil then Exit;

  { Save state }
  SaveState;

  { Add TSeSkinObject }
  Inc(FCount);
  if GetOwner <> nil then
  begin
    SkinObject := ObjectClass.Create(GetOwner);
    SkinObject.BoundsRect := Rect(GetOwner.Left, GetOwner.Top, GetOwner.Left +
      30, GetOwner.Top + 20);
    S := SkinObject.ClassName;
    Delete(S, 1, 3);
    SkinObject.Name := S + IntToStr(FCount);
    SkinObject.Bitmaps := FSkinSource.Bitmaps;

    FSelected := SkinObject;
    UpdateSkin;
    SelectObject(SkinObject);
  end
  else
  begin
    SkinObject := ObjectClass.Create(nil);
    SkinObject.BoundsRect := Rect(0, 0, 200, 100);
    S := SkinObject.ClassName;
    Delete(S, 1, 3);
    SkinObject.Name := S + IntToStr(FCount);
    SkinObject.Bitmaps := FSkinSource.Bitmaps;

    FSkinSource.Add(SkinObject);

    FRoot := SkinObject;
    FSelected := SkinObject;

    UpdateSkin;
    SelectObject(SkinObject);
  end;
  FModified := true;
end;

procedure TfrmMain.DeleteSkinObject;
var
  Owner: TSeSkinObject;
begin
  { Delete }
  if (FSelected <> nil) and (FSelected.Owner <> nil) and
     (FSelected.Owner is TSeSkinObject)
  then
  begin
    Owner := FSelected.Owner as TSeSkinObject;
    Owner.Remove(FSelected);
    FSelected.Free;

    FSelected := Owner;
    UpdateSkin;
    FModified := true;
    Exit;
  end;

  if (FSelected <> nil) and (FSelected = FRoot) then
  begin
    FSkinSource.Remove(FSelected);

    FSelected.Free;
    FSelected := nil;
    if FSkinSource.Form <> nil then
      FRoot := FSkinSource.Form
    else
      FRoot := nil;
    UpdateSkin;
    FModified := true;
  end;
end;

{ Enents ======================================================================}

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  TempSkinFile := ExtractFilePath(ParamStr(0))+'temp_skin.mskn';

  OpenDialog.DefaultExt := DefaultFilter.GetFileExtension;
  OpenDialog.Filter := GetDialogFilter;
  SaveDialog.DefaultExt := DefaultFilter.GetFileExtension;
  SaveDialog.Filter := GetDialogFilter;

  FStateList := TList.Create;

  FInspector := TZPropList.Create(Self);
  with FInspector do
  begin
    Parent := Panel7;
    Align := alClient;
    Name := 'FInspector';

    OnChange := DoInspectorChange;
    OnChanging := DoInspectorChanging;
  end;

  DesignMode := true;
  CreateSkin;
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
var
  i: integer;
begin
  DeleteFile(TempSkinFile);

  for i := 0 to FStateList.Count - 1 do
    TMemoryStream(FStateList[i]).Free;
  FStateList.Free;

  Clear;
end;

procedure TfrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  {}
  if FModified then
  begin
    case MessageDlg('Skin''s was changed. Save?', mtConfirmation, [mbYes, mbNo, mbCancel], 0) of
      mrYes: SaveSkin;
      mrCancel: CanClose := false;
    end;
  end;
end;

procedure TfrmMain.Exit1Click(Sender: TObject);
begin
  { Exit }
  Close;
end;

procedure TfrmMain.actnFileNewExecute(Sender: TObject);
begin
  CreateSkin;
end;

procedure TfrmMain.actnFileOpenExecute(Sender: TObject);
begin
  OpenSkin;
end;

procedure TfrmMain.actnFileSaveExecute(Sender: TObject);
begin
  SaveSkin;
end;

procedure TfrmMain.actnFileSaveAsExecute(Sender: TObject);
begin
  SaveSkinAs;
end;

procedure TfrmMain.SkinTreeChange(Sender: TObject; Node: TTreeNode);
begin
  if Node = nil then Exit;
  if Node.Data = nil then Exit;
  if FBuilding then Exit;
  { Select Root }
  if Node.Data = FSkinSource then
  begin
    Panel1.Caption := ' Objects Root';
    SelectObject(nil);
    Exit;
  end;
  { Select "Images" }
  if Node.Data = PanelImages then
  begin
    Panel1.Caption := ' Objects Tree - Images';
    ShowPanel(vImage);
    Exit;
  end;
  { Select SkinObject }
  if TObject(Node.Data) is TSeSkinObject then
  begin
    SelectObject(TseSkinObject(Node.Data));
    Exit;
  end;
  { Select Bitmap }
  if TObject(Node.Data) is TSeBitmap then
  begin
    SelectBitmap(TSeBitmap(Node.Data));
    Exit;
  end;
end;

procedure TfrmMain.btnDeleteClick(Sender: TObject);
begin
  DeleteSkinObject;
  FModified := true;
end;

procedure TfrmMain.ShowPanel(View: TPanelView);
begin
  case View of
    vWork: begin
      PanelImages.Hide;
      FSelectedBitmap := nil;
      PanelWork.Show;
    end;
    vImage: begin
      PanelWork.Hide;
      FSelected := nil;
      FRoot := nil;
      PanelImages.Show;
    end;
  end;
end;

procedure TfrmMain.btnAddImageClick(Sender: TObject);
var
  Bmp: TSeBitmap;
begin
  if FSkinSource = nil then Exit;

  { Add Image }
  FModified := true;

  Bmp := OpenSkinBitmap;
  if Bmp <> nil then
  begin
    { Add Image }
    FSkinSource.Bitmaps.Add(Bmp);
    FSelectedBitmap := Bmp;
    UpdateSkin;
    SelectBitmap(FSelectedBitmap);

⌨️ 快捷键说明

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