Сохранение размера и позиции формы в Delphi

Часто в приложении требуется сохранить размер и положение окна (формы). Встроенной технологии в Delphi нет. В интернете можно найти различные способы хранения как в INI так и в реестре. Я предлагаю другой вариант. Использовать TPersistant.
Для удобства я поместил все в DLL.


library swpas;

{  SWPAS - Save Windows Position And Size

   Библиотека для сохранения размера и положения формы.
   24.09.2014  Кутовой Максим

   После создания формы загружаем ее размеры и положение из файла. Если его нет,
   то размеры и положение будут как при разработке приложения. После закрытия
   формы сохраняем ее размер и положения в файл. Если не указать имя файла, то
   все будет сохранено в файл <ИМЯ_ФОРМЫ>.frm

     Формат вызова процедур в программе
     procedure LoadFormPositionAndSize(AForm: TForm; APath : string = ''); external 'swpas.dll';
     procedure SaveFormPositionAndSize(AForm: TForm; APath : string = ''); external 'swpas.dll';

     procedure LFPAS(AForm: TForm; APath : string = ''); external 'swpas.dll';
     procedure SFPAS(AForm: TForm; APath : string = ''); external 'swpas.dll';


     Использование в программе:

     procedure TForm1.Button1Click(Sender: TObject);
     var
       NewForm : TForm;
     begin
      NewForm := TForm2.Create(self);
      LFPAS(NewForm);
      NewForm.ShowModal;
      SFPAS(NewForm);
      FreeAndNil(NewForm);
     end;
   }


uses
  System.SysUtils,
  System.Classes,
  VCL.Forms;

{$R *.res}

{
 ****
 ****  КЛАСС для сохранения свойств формы
 ****
}

type
  TSavedForm = class(TPersistent)
  private

    FHeight: Integer;
    FLeft: Integer;
    FTop: Integer;
    FWidth: Integer;

    {Установка свойств}
    procedure SetHeight(const Value: integer);
    procedure SetLeft(const Value: Integer);
    procedure SetTop(const Value: Integer);
    procedure SetWidth(const Value: integer);

    {Получение свойств}
    function GetHeight: integer;
    function GetLeft: Integer;
    function GetTop: Integer;
    function GetWidth: integer;
  public
    {Конструктор}
    constructor Create;

  published
    Property Left: Integer read GetLeft write SetLeft;
    property Top: Integer read GetTop write SetTop;
    property Width: integer read GetWidth write SetWidth;
    property Height: integer read GetHeight write SetHeight;

  end;

{ AForm }

constructor TSavedForm.Create;
begin
  inherited;
end;

function TSavedForm.GetHeight: integer;
begin
  result := FHeight;
end;

function TSavedForm.GetLeft: Integer;
begin
  result := FLeft;
end;

function TSavedForm.GetTop: Integer;
begin
  result := FTop
end;

function TSavedForm.GetWidth: integer;
begin
  result := FWidth;
end;

procedure TSavedForm.SetHeight(const Value: integer);
begin
  FHeight := Value;
end;

procedure TSavedForm.SetLeft(const Value: Integer);
begin
  FLeft := Value;
end;

procedure TSavedForm.SetTop(const Value: Integer);
begin
  FTop := Value;
end;

procedure TSavedForm.SetWidth(const Value: integer);
begin
  FWidth := Value;
end;


{
  ***
  ***  Процедуры для сохранения объекта  в файл
  ***  Можно вынести в отдельный модуль или библиотеку.
  ***
}

type
  TObjWriter = class(TWriter)
  end;
  TObjReader = class(TReader)
  end;


procedure WriteObj(obj: TPersistent; st: TStream);
begin
  with TObjWriter.Create(st, 64) do
  begin
    WriteProperties(obj);
    FlushBuffer; Free;
  end;
end;


procedure ReadObj(obj: TPersistent; st: TStream);
begin
  with TObjReader.Create(st, 1) do
  begin
    while st.Position < st.Size do
    try ReadProperty(obj); except Continue; end;
    Free;
  end;
end;


procedure SaveObjToFile(obj: TPersistent; FileName: string);
var fs: TFileStream;
begin
  try
    fs := TFileStream.Create(FileName, fmCreate or fmShareDenyWrite);
    try
      WriteObj(obj, fs);
    finally
      fs.Free;
    end;
  except end;
end;


procedure LoadObjFromFile(obj: TPersistent; FileName: string);
var fs: TFileStream;
begin
  if FileExists(FileName) then try
    fs := TFileStream.Create(FileName, fmShareDenyWrite);
    try
      ReadObj(obj, fs);
    finally
      fs.Free;
    end;
  except end;
end;



{
 ***
 ***  Процедуры для работы
 ***
}


// Загрузка позиции и размеров формы
procedure LoadFormPositionAndSize(AForm: TForm; APath: string);
var
  F : TSavedForm;
  fn : string;
begin
  F:= TSavedForm.Create;
  if APath = '' then
    fn := ExtractFilePath(ParamStr(0)) + AForm.Name + '.frm'
  else
    fn := APAth;
  if FileExists(fn) then begin
     LoadObjFromFile(F, fn);
     AForm.Height := F.Height;
     AForm.Width := F.Width;
     AForm.Top := F.Top;
     AForm.Left := F.Left;
  end;
  FreeAndNil(F);
end;

// Сохранение позиции и размеров формы
procedure SaveFormPositionAndSize(AForm: TForm; AFileName: string);
var
  F : TSavedForm;
  fn : string;
begin
  F := TSavedForm.Create;
  F.Height :=  AForm.Height;
  F.Width :=  AForm.Width;
  F.Top :=  AForm.Top;
  F.Left :=  AForm.Left;
  if AFileName =  '' then
    fn := ExtractFilePath(ParamStr(0)) + AForm.Name + '.frm'
  else
     fn := AFileName;
  SaveObjToFile(F, fn);
  FreeAndNil(F);
end;

// Теже процедуры но с сокращенным именем.
procedure SFPAS(AForm: TForm; AFileName: string);
begin
  SaveFormPositionAndSize(AForm, AFileName);
end;

procedure LFPAS(AForm: TForm; AFileName: string);
begin
  LoadFormPositionAndSize(AForm, AFileName);
end;



exports
   SaveFormPositionAndSize, LoadFormPositionAndSize, SFPAS, LFPAS;

begin
end.

Готовую DLL можно взять здесь: swpas.dll

Раскраска элементов TreeView

Легко: обрабатывай OnCustomDrawItem, в котором и назначай цвет:

Код Delphi
1 2 3 4 5 6 7 8 9 10 procedure TForm1.TreeView1CustomDrawItem(Sender: TCustomTreeView;   Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean); begin    case Integer(Node.Data) of       1 : Sender.Canvas.Font.Color := clRed;       2 : Sender.Canvas.Font.Color := clBlue;       else          Sender.Canvas.Font.Color:= clBlack;    end; end;

, и добавляй свои элементы в дерево. Цвет будет зависеть от значения поля Data:

Код Delphi

1 2 3 4 5 6 7 8 9 10 11 procedure TForm1.Button1Click(Sender: TObject); begin    with TreeView1.Items.AddChild(nil, 'First red') do       Data := Pointer(1);    with TreeView1.Items.AddChild(nil, 'Second red') do       Data := Pointer(1);    with TreeView1.Items.AddChild(nil, 'First blue') do       Data := Pointer(2);    with TreeView1.Items.AddChild(nil, 'Black') do       Data := Pointer(0); end;

http://www.cyberforum.ru/delphi-beginners/thread728793.html

Автозагрузка приложения при старте Windows

Пишем библиотеку:

library autorun;

uses
  Windows,
  Registry;

{$R *.res}


procedure RunOnWinStart(Flag:boolean; NameParam, Path:String);
var Reg:TRegistry;
begin
  if Flag then
  begin
     Reg := TRegistry.Create;
     Reg.RootKey := HKEY_CURRENT_USER;
     Reg.OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion\Run', false);
     Reg.WriteString(NameParam, Path);
     Reg.Free;
  end
  else
  begin
     Reg := TRegistry.Create;
     Reg.RootKey := HKEY_CURRENT_USER;
     Reg.OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion\Run',false);
     Reg.DeleteValue(NameParam);
     Reg.Free;
  end;
end;

exports
  RunOnWinStart;

begin
end.

Далее в программе делаем ее динамическое выполнение:

procedure SetRunOnStart(const Value: boolean);

var

  LibHandle:Integer;

  Fc_AutoRun: procedure(Flag:boolean; NameParam, Path:String);

begin

  FRunOnStart := Value;

    LibHandle := LoadLibrary('autorun.dll');

      if LibHandle >=32 then

        begin

          @Fc_AutoRun := GetProcAddress(LibHandle, 'RunOnWinStart');

          Fc_autoRun(Value, Application.title, paramstr(0));

        end;

    FreeLibrary(LibHandle);

end;