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

📄 main.pas

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

interface                        

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, ComCtrls, Buttons, Menus, ImgList, KsSkinObjects, se_controls,
  KsSkinSource, ActnList, ZPropLst, StdCtrls, ToolWin, ExtDlgs,
  KsSkinObjects2, KsSkinVersion;

type

  TPanelView = (vWork, vImage);
  TGripKind = (gkMove, gkTopLeft, gkTopRight, gkBottomLeft, gkBottomRight);

  TfrmMain = class(TForm)
    LeftPanel: TPanel;
    TopPanel: TPanel;
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    SkinTree: TTreeView;
    Panel4: TPanel;
    Panel5: TPanel;
    Panel6: TPanel;
    Splitter1: TSplitter;
    Splitter2: TSplitter;
    PanelWork: TPanel;
    btnNew: TSpeedButton;
    btnOpen: TSpeedButton;
    btnSave: TSpeedButton;
    MainMenu: TMainMenu;
    Glyphs: TImageList;
    File1: TMenuItem;
    New1: TMenuItem;
    Open1: TMenuItem;
    Save1: TMenuItem;
    N1: TMenuItem;
    Exit1: TMenuItem;
    Actions: TActionList;
    actnFileNew: TAction;
    actnFileOpen: TAction;
    actnFileSave: TAction;
    actnFileSaveAs: TAction;
    Saveas1: TMenuItem;
    Help1: TMenuItem;
    OpenDialog: TOpenDialog;
    SaveDialog: TSaveDialog;
    Panel7: TPanel;
    Tabs: TTabControl;
    PageOld: TPageScroller;
    Panel10: TPanel;
    btnSelect: TSpeedButton;
    cbScale: TComboBox;
    btnDelete: TSpeedButton;
    Label1: TLabel;
    SpeedButton1: TSpeedButton;
    ScrollBox1: TScrollBox;
    WorkArea: TPaintBox;
    PanelImages: TPanel;
    Panel8: TPanel;
    Panel9: TPanel;
    Panel11: TPanel;
    btnAddImage: TButton;
    ImageView: TImage;
    btnDelImage: TButton;
    actnTestEmpty: TAction;
    btnFront: TSpeedButton;
    PageStandard: TPageScroller;
    SpeedButton11: TSpeedButton;
    actnCopy: TAction;
    actnPaste: TAction;
    Edit1: TMenuItem;
    Copyto1: TMenuItem;
    Pas1: TMenuItem;
    SpeedButton12: TSpeedButton;
    SkinToolBar: TToolBar;
    ToolButton2: TToolButton;
    btnBitmapSkinObject: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    SpeedButton4: TSpeedButton;
    SpeedButton5: TSpeedButton;
    SpeedButton6: TSpeedButton;
    SpeedButton7: TSpeedButton;
    SpeedButton8: TSpeedButton;
    SpeedButton9: TSpeedButton;
    SpeedButton10: TSpeedButton;
    ToolBar2: TToolBar;
    btnSkinObject: TSpeedButton;
    ToolButton1: TToolButton;
    btnBitmapObject: TSpeedButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    btnActiveObject: TSpeedButton;
    btnActiveBitmap: TSpeedButton;
    ToolButton5: TToolButton;
    btnSystemButton: TSpeedButton;
    ToolButton6: TToolButton;
    btnButtonObject: TSpeedButton;
    SpeedButton13: TSpeedButton;
    Panel14: TPanel;
    Button1: TButton;
    cbCharset: TComboBox;
    KSDevelopmantSite1: TMenuItem;
    N2: TMenuItem;
    AboutSkinBuilder1: TMenuItem;
    actnTest: TAction;
    Panel15: TPanel;
    Label6: TLabel;
    Label7: TLabel;
    ToolButton7: TToolButton;
    btnTextObject: TSpeedButton;
    Panel12: TPanel;
    actnUndo: TAction;
    N3: TMenuItem;
    Undo1: TMenuItem;
    btnReplaceImage: TBitBtn;
    actnExport: TAction;
    N4: TMenuItem;
    ExportBitmaps1: TMenuItem;
    SpeedButton14: TSpeedButton;
    procedure Exit1Click(Sender: TObject);
    procedure actnFileNewExecute(Sender: TObject);
    procedure actnFileOpenExecute(Sender: TObject);
    procedure actnFileSaveExecute(Sender: TObject);
    procedure actnFileSaveAsExecute(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure WorkAreaPaint(Sender: TObject);
    procedure cbScaleChange(Sender: TObject);
    procedure SkinTreeChange(Sender: TObject; Node: TTreeNode);
    procedure WorkAreaMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure btnDeleteClick(Sender: TObject);
    procedure btnSkinObjectClick(Sender: TObject);
    procedure btnAddImageClick(Sender: TObject);
    procedure btnBitmapSkinObjectClick(Sender: TObject);
    procedure btnDelImageClick(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure actnTestEmptyExecute(Sender: TObject);
    procedure SpeedButton4Click(Sender: TObject);
    procedure SpeedButton5Click(Sender: TObject);
    procedure SpeedButton6Click(Sender: TObject);
    procedure SpeedButton7Click(Sender: TObject);
    procedure SpeedButton8Click(Sender: TObject);
    procedure SpeedButton9Click(Sender: TObject);
    procedure SpeedButton10Click(Sender: TObject);
    procedure btnBackClick(Sender: TObject);
    procedure TabsChange(Sender: TObject);
    procedure actnCopyExecute(Sender: TObject);
    procedure actnPasteExecute(Sender: TObject);
    procedure btnBitmapObjectClick(Sender: TObject);
    procedure btnActiveObjectClick(Sender: TObject);
    procedure btnActiveBitmapClick(Sender: TObject);
    procedure btnSystemButtonClick(Sender: TObject);
    procedure btnButtonObjectClick(Sender: TObject);
    procedure SpeedButton13Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure KSDevelopmantSite1Click(Sender: TObject);
    procedure AboutSkinBuilder1Click(Sender: TObject);
    procedure actnTestExecute(Sender: TObject);
    procedure btnTextObjectClick(Sender: TObject);
    procedure WorkAreaMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure WorkAreaMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormDestroy(Sender: TObject);
    procedure actnUndoExecute(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure btnReplaceImageClick(Sender: TObject);
    procedure actnExportExecute(Sender: TObject);
    procedure SpeedButton14Click(Sender: TObject);
  private
    { Private declarations }
    FInspector: TZPropList;
    FSkinSource: TSeSkinSource;
    FRoot: TSeSkinObject;
    FSelected: TSeSkinObject;
    FSelectedBitmap: TSeBitmap;
    FModified: boolean;
    FFileName: string;
    FScale: single;
    FCount: integer;
    FBuilding: boolean;
    FMyClipboard: string;
    FDragging: boolean;
    FDragGrip: TGripKind;
    FDragPoint: TPoint;
    FStateList: TList;
    FStateNum: integer;
    procedure Clear;
    procedure CreateSkin;
    procedure OpenSkin;
    procedure SaveSkin;
    procedure SaveSkinAs;
    function HasModified: boolean;
    function GetOwner: TSeSkinObject;
    procedure UpdateSkin;
    procedure BuildTree;
    procedure CreateSkinObject(ObjectClass: TSeSkinObjectClass);
    procedure DeleteSkinObject;
    procedure SelectObject(SkinObject: TSeSkinObject);
    procedure SelectBitmap(Bitmap: TSeBitmap);
    procedure ShowPanel(View: TPanelView);
    procedure AddCharsetItem(const S: string);
    function GetGripRect(GripKind: TGripKind): TRect;
    { Undo/Redo }
    procedure SaveState;
    procedure RestoreState;
    procedure DoInspectorChanging(Sender: TZPropList; var CanChange: Boolean);
    procedure DoInspectorChange(Sender: TObject);
  public
    { Public declarations }
    property SkinSource: TSeSkinSource read FSkinSource;
  end;

const

  sEmptySkin = 'skin.kskn';

var
  frmMain: TfrmMain;

implementation {===============================================================}

uses OpenBitmap, TestForm, Clipbrd, EmptyForm, ShellAPI, about, ExportForm,
  pickcolor;

{$R *.DFM}

const
  GripSize = 3;

type

  PCharArray = ^TCharArray;
  TCharArray = array [0..MaxInt-1] of char;

var
  TempSkinFile: string;
  SaveData: PCharArray;

type
  TCompAccess = class(TComponent);

  TStateClass = class(TPersistent)
  private
    FRoot: string;
    FSelected: string;
    FStream: TStream;
  public
    constructor Create;
    destructor Destroy; override;
    property Stream: TStream read FStream write FStream;
    property Root: string read FRoot write FRoot;
    property Selected: string read FSelected write FSelected;
  end;

{ TStateClass }

constructor TStateClass.Create;
begin
  inherited Create;
  FStream := TMemoryStream.Create;
end;

destructor TStateClass.Destroy;
begin
  if FStream <> nil then FStream.Free;
  inherited;
end;

{ TfrmMain class }

procedure TfrmMain.Clear;
begin
  FRoot := nil;
  FSelected := nil;
  FSelectedBitmap := nil;
  FModified := false;

  FScale := 1;
  cbScale.ItemIndex := 0;
end;

procedure TfrmMain.CreateSkin;
var
  SkinObject: TSeSkinObject;
begin
  { Create }
  if HasModified then
  begin
    if FSkinSource <> nil then
      FSkinSource.Free;

    { Create }
    FSkinSource := TSeSkinSource.Create(nil);
    { Add standard object }
    SkinObject := TSeSkinObject.Create(nil);
    SkinObject.Name := 'Form';
    SkinObject.Kind := skForm;
    SkinObject.BoundsRect := Rect(0, 0, 300, 250);
    FSkinSource.Add(SkinObject);
    { Set property }
    FFileName := sEmptySkin;
    Clear;
    UpdateSkin;
  end;
end;

procedure TfrmMain.OpenSkin;
begin
  { Open }
  if HasModified then
  begin
    if OpenDialog.Execute then
    begin
      if FSkinSource <> nil then
        FSkinSource.Free;
      FSkinSource := TSeSkinSource.Create(nil);
      FSkinSource.LoadFromFile(OpenDialog.FileName);

      Clear;
      FFileName := OpenDialog.FileName;
      UpdateSkin;
    end;
  end;
end;

procedure TfrmMain.SaveSkin;
begin
  { Save }
  if FModified then
  begin
    if FFileName = sEmptySkin then
      SaveSkinAs
    else
      FSkinSource.SaveToFile(FFileName);

    FModified := false;
    UpdateSkin;
  end;
end;

procedure TfrmMain.SaveSkinAs;
begin
  { Save }
  if SaveDialog.Execute then
  begin
    FSkinSource.SaveToFile(SaveDialog.FileName);

    FFileName := SaveDialog.FileName;
    FModified := false;
    UpdateSkin;
  end;
end;

function TfrmMain.HasModified: boolean;
begin
  Result := true;

  if (FSkinSource <> nil) then
  begin
    if FModified then
      case MessageDlg('Skin has modified. Save changes?', mtConfirmation, [mbYes, mbNo, mbCancel], 0) of
        mrYes: SaveSkin;
        mrNo: Result := true;
        mrCancel: Result := false;
      end;
  end;
end;

procedure TfrmMain.UpdateSkin;
var
  SkinObject: TSeSkinObject;
begin
  Caption := 'SkinBuilder ' +sSeSkinVersion+ ' - ['+FFileName+']';

  BuildTree;

  if FRoot <> nil then
  begin
    { Set Title }
    SkinObject := FRoot.FindObjectByKind(skTitle);
    if SkinObject <> nil then
      SkinObject.Text := 'Skin Builder Title';
    { Set MenuBar and PopupMenu Item Text  }
    SkinObject := FRoot.FindObjectByName('Item');
    if SkinObject <> nil then
      SkinObject.Text := 'Item Text';
    { Set Text Object text  }
    SkinObject := FRoot.FindObjectByName('Text');
    if SkinObject <> nil then
      SkinObject.Text := 'Sample';
    { Set Text Object text  }
    SkinObject := FRoot.FindObjectByName('ToolbarItem');
    if SkinObject <> nil then
      SkinObject.Text := 'Item Text';
    { Set Caption Object text  }
    SkinObject := FRoot.FindObjectByName('Caption');
    if SkinObject <> nil then
      SkinObject.Text := 'Caption';

    WorkArea.Width := Round(FRoot.Width * FScale);
    WorkArea.Height := Round(FRoot.Height * FScale);

    FRoot.Aligning;
  end;

  WorkAreaPaint(Self);
end;

{ Inspector and Tree }

procedure TfrmMain.AddCharsetItem(const S: string);
begin
  cbCharset.Items.Add(S);
end;

procedure TfrmMain.BuildTree;

 procedure AddObject(Node: TTreeNode; SkinObject: TSeSkinObject); overload;
 var
   i: integer;
   AddNode: TTreeNode;
   Child: TTreeNode;
 begin
   Child := SkinTree.Items.AddChild(Node, SkinObject.Name);
   Child.Data := SkinObject;

   if SkinObject = FSelected then
      Child.Selected := true;

   for i := 0 to SkinObject.Count-1 do
   begin
     if SkinObject[i].Count > 0 then
       AddObject(Child, SkinObject[i])
     else
     begin
       AddNode := SkinTree.Items.AddChild(Child, SkinObject[i].Name);
       AddNode.Data := SkinObject[i];

       if SkinObject[i] = FSelected then
         AddNode.Selected := true;
     end;
   end;
 end;

 procedure AddObject(Node: TTreeNode; Bitmap: TSeBitmap); overload;
 var
   Child: TTreeNode;
 begin
   Child := SkinTree.Items.AddChild(Node, Bitmap.Name);
   Child.Data := Bitmap;

   if Bitmap = FSelectedBitmap then
     Child.Selected := true;
 end;

var
  i: integer;
  SkinObject: TSeSkinObject;
  Bitmap: TSeBitmap;
  Node: TTreeNode;
  S: string;
begin
  { Make charsert List }
  cbCharset.Items.Clear;
  GetCharsetValues(AddCharsetItem);
  CharsetToIdent(DEFAULT_CHARSET, S);
  cbCharset.ItemIndex := cbCharset.Items.IndexOf(S);

  if FBuilding then Exit;

  FBuilding := true;

  SkinTree.Items.BeginUpdate;
  try
    SkinTree.Items.Clear;

    { Make Root }
    Node := SkinTree.Items.AddChild(nil, 'Skin Source');
    Node.Data := FSkinSource;
    if FSelected = nil then
    begin
      Node.Selected := true;
      FInspector.CurObj := FskinSource;
    end;
    { Build Objects Tree }
    for i := 0 to FSkinSource.Count-1 do
    begin
      SkinObject := FSkinSource[i];
      AddObject(Node, SkinObject);
    end;
    { Build Images Tree }
    Node := SkinTree.Items.AddChild(nil, 'Images');
    Node.Data := PanelImages;
    for i := 0 to FSkinSource.Bitmaps.Count-1 do
    begin
      Bitmap := FSkinSource.Bitmaps[i];
      AddObject(Node, Bitmap);
    end;
  finally
    SkinTree.Items.EndUpdate;
    FBuilding := false;
  end;
end;

procedure TfrmMain.SelectObject(SkinObject: TSeSkinObject);
var
  Par: TSeSkinObject; 
begin
  ShowPanel(vWork);

  if SkinObject = nil then
  begin
    { Is a root }
    FInspector.CurObj := FSkinSource;
    FSelected := nil;
    FRoot := nil;
    Panel1.Caption := ' Objects Tree - Skin Source';
    UpdateSkin;

⌨️ 快捷键说明

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