Marco Web Center

[an error occurred while processing this directive]

Home: Code Repository: Mastering Delphi 6

Chapter 05 - Project FormToText

Project Structure

FormToText.dpr
program FormToText;

uses
  Forms,
  FormTextForm in 'FormTextForm.pas' {formText};

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TformText, formText);
  Application.Run;
end.
FormTextForm.pas
unit FormTextForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls;

type
  TformText = class(TForm)
    memoOut: TMemo;
    pBar: TPanel;
    btnResource: TButton;
    btnCurrent: TButton;
    btnPanel: TButton;
    procedure btnResourceClick(Sender: TObject);
    procedure btnCurrentClick(Sender: TObject);
    procedure btnPanelClick(Sender: TObject);
  private
    { Private declarations }
  public
    procedure ConvertAndShow (aStream: TStream);
  end;

var
  formText: TformText;

implementation

{$R *.DFM}

procedure TformText.btnResourceClick(Sender: TObject);
var
  ResStr: TResourceStream;
begin
  ResStr := TResourceStream.Create(
    hInstance, 'TFORMTEXT', RT_RCDATA);
  try
    ConvertAndShow (ResStr);
  finally
    ResStr.Free
  end;
end;

procedure TformText.btnCurrentClick(Sender: TObject);
var
  MemStr: TStream;
begin
  MemStr := TMemoryStream.Create;
  try
    MemStr.WriteComponent (Self);
    ConvertAndShow (MemStr);
  finally
    MemStr.Free
  end;
end;

procedure TformText.ConvertAndShow (aStream: TStream);
var
  ConvStream: TStream;
begin
  aStream.Position := 0;
  ConvStream := TMemoryStream.Create;
  try
    ObjectBinaryToText (aStream, ConvStream);
    ConvStream.Position := 0;
    MemoOut.Lines.LoadFromStream (ConvStream);
  finally
    ConvStream.Free
  end;
end;

procedure TformText.btnPanelClick(Sender: TObject);
var
  MemStr: TStream;
begin
  MemStr := TMemoryStream.Create;
  try
    MemStr.WriteComponent (pBar);
    ConvertAndShow (MemStr);
  finally
    MemStr.Free
  end;
end;

end.
FormTextForm.dfm
object formText: TformText
  Left = 191
  Top = 113
  Width = 545
  Height = 374
  Caption = 'Form To Text'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = True
  PixelsPerInch = 96
  TextHeight = 13
  object memoOut: TMemo
    Left = 0
    Top = 41
    Width = 537
    Height = 306
    Align = alClient
    Color = clWindow
    ScrollBars = ssVertical
    TabOrder = 0
  end
  object pBar: TPanel
    Left = 0
    Top = 0
    Width = 537
    Height = 41
    Align = alTop
    BevelOuter = bvLowered
    TabOrder = 1
    object btnResource: TButton
      Left = 360
      Top = 8
      Width = 169
      Height = 25
      Caption = 'Form in Executable File'
      TabOrder = 0
      OnClick = btnResourceClick
    end
    object btnCurrent: TButton
      Left = 8
      Top = 8
      Width = 169
      Height = 25
      Caption = 'Current Form Object'
      TabOrder = 1
      OnClick = btnCurrentClick
    end
    object btnPanel: TButton
      Left = 184
      Top = 8
      Width = 169
      Height = 25
      Caption = 'Panel Object'
      TabOrder = 2
      OnClick = btnPanelClick
    end
  end
end