Недавно добавленные исходники

•  DeLiKaTeS Tetris (Тетрис)  161

•  TDictionary Custom Sort  3 337

•  Fast Watermark Sources  3 089

•  3D Designer  4 847

•  Sik Screen Capture  3 343

•  Patch Maker  3 553

•  Айболит (remote control)  3 659

•  ListBox Drag & Drop  3 015

•  Доска для игры Реверси  81 702

•  Графические эффекты  3 945

•  Рисование по маске  3 249

•  Перетаскивание изображений  2 629

•  Canvas Drawing  2 752

•  Рисование Луны  2 580

•  Поворот изображения  2 189

•  Рисование стержней  2 168

•  Paint on Shape  1 568

•  Генератор кроссвордов  2 236

•  Головоломка Paletto  1 767

•  Теорема Монжа об окружностях  2 229

•  Пазл Numbrix  1 685

•  Заборы и коммивояжеры  2 057

•  Игра HIP  1 282

•  Игра Go (Го)  1 230

•  Симулятор лифта  1 475

•  Программа укладки плитки  1 216

•  Генератор лабиринта  1 548

•  Проверка числового ввода  1 366

•  HEX View  1 497

•  Физический маятник  1 358

 
скрыть


Delphi FAQ - Часто задаваемые вопросы

| Базы данных | Графика и Игры | Интернет и Сети | Компоненты и Классы | Мультимедиа |
| ОС и Железо | Программа и Интерфейс | Рабочий стол | Синтаксис | Технологии | Файловая система |



Delphi Sources

Сохранение в файле и загрузка из файла формы с компонентами





unit Cref_f;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes,
  Graphics, Controls, Forms, Dialogs, StdCtrls,
  ExtCtrls, Menus;

type
  CRefType = class of TControl;
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Exit1: TMenuItem;
    N1: TMenuItem;
    SaveAs1: TMenuItem;
    Open1: TMenuItem;
    New1: TMenuItem;
    Help1: TMenuItem;
    About1: TMenuItem;
    Panel1: TPanel;
    RadioRadioButton: TRadioButton;
    ButtonRadioButton: TRadioButton;
    EditRadioButton: TRadioButton;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    SaveAs2: TMenuItem;
    N2: TMenuItem;
    SaveDialog2: TSaveDialog;
    MemoRadioButton: TRadioButton;
    procedure RadioButtonRadioClick(Sender: TObject);
    procedure RadioButtonButtonClick(Sender: TObject);
    procedure RadioButtonEditClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormMouseDown(Sender: TObject;
      Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure New1Click(Sender: TObject);
    procedure Open1Click(Sender: TObject);
    procedure SaveAs1Click(Sender: TObject);
    procedure About1Click(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
    procedure SaveAs2Click(Sender: TObject);
    procedure MemoRadioButtonClick(Sender: TObject);
  private
    ClassRef: CRefType;
    Counter: Integer;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.RadioButtonRadioClick(Sender: TObject);
begin
  ClassRef := TRadioButton;
end;

procedure TForm1.RadioButtonButtonClick(Sender: TObject);
begin
  ClassRef := TButton;
end;

procedure TForm1.RadioButtonEditClick(Sender: TObject);
begin
  ClassRef := TEdit;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ClassRef := TRadioButton;
  Counter := 0;
end;

procedure TForm1.FormMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  MyObj: TControl;
  MyName: String;
begin
  {create an object using the current class reference}
  MyObj := ClassRef.Create (self);
  MyObj.Visible := False;
  MyObj.Parent := self;
  MyObj.Left := X;
  MyObj.Top := Y;
  Inc (Counter);
  {define the name using the class name, without the
  initial T, and the number of the Counter}
  MyName := ClassRef.ClassName + IntToStr (Counter);
  Delete (MyName, 1, 1);
  MyObj.Name := MyName;
  MyObj.Visible := True;
end;

procedure TForm1.New1Click(Sender: TObject);
var
  I: Integer;
begin
  {delete all existing components, except the panel}
  for I := ControlCount - 1 downto 0 do
    if Controls[I].ClassName <> 'TPanel' then
      Controls[I].Free;
  Counter := 0;
end;

procedure TForm1.Open1Click(Sender: TObject);
var
  S: TFileStream;
  New: TComponent;
  Reader1: TReader; // new line
begin
  if OpenDialog1.Execute then
  begin
    {remove existing controls}
    New1Click (self);

    {open the stream}
    S := TFileStream.Create (OpenDialog1.FileName,
      fmOpenRead);
    try
      while S.Position < S.Size do
      begin
        {read a component and add it to the form}

        // old code:
//        New := S.ReadComponent (nil);
//        InsertControl (New as TControl);

        // new code:
        Reader1 := TReader.Create (S, 4096);
        try
          Reader1.Parent := self;
          New := Reader1.ReadRootComponent (nil);
          InsertComponent (New);
        finally
          Reader1.Free;
        end;

        Inc (Counter);
      end;
    finally
      S.Free;
    end;
  end;
end;

procedure TForm1.SaveAs1Click(Sender: TObject);
var
  S: TFileStream;
  I: Integer;
begin
  if SaveDialog1.Execute then
  begin
    {open or create the stream file}
    S := TFileStream.Create (SaveDialog1.FileName,
      fmOpenWrite or fmCreate);
    try
      {save each component except the panel}
      for I := 0 to ControlCount - 1 do
        if Controls[I].ClassName <> 'TPanel' then
          S.WriteComponent (Controls[I]);
    finally
      S.Free;
    end;
  end;
end;

procedure TForm1.About1Click(Sender: TObject);
begin
  MessageDlg ('CREF2 Example: Save components to file' +
    Chr(13) + 'From "Mastering Delphi", by Marco Cantщ',
    mtInformation, [mbOk], 0);
end;

procedure TForm1.Exit1Click(Sender: TObject);
begin
  Close;
end;

{save form file}
procedure TForm1.SaveAs2Click(Sender: TObject);
begin
  if SaveDialog2.Execute then
    WriteComponentResFile
      (SaveDialog2.Filename, self);
end;

procedure TForm1.MemoRadioButtonClick(Sender: TObject);
begin
  ClassRef := TMemo;
end;

initialization
  {register the classes of the components; this code is
  required by the stream loader}
  RegisterClasses ([TRadioButton, TEdit, TButton, TMemo]);
end.

Загрузить весь проект





Похожие по теме исходники

Разбиение файла на части

Текст внутри файла




Copyright © 2004-2024 "Delphi Sources" by BrokenByte Software. Delphi World FAQ

Группа ВКонтакте