unit ads_DlgMemo;
{Copyright(c)2000 Advanced Delphi Systems
Richard Maley
Advanced Delphi Systems
12613 Maidens Bower Drive
Potomac, MD 20854 USA
phone 301-840-1554
maley@advdelphisys.com
The code herein can be used or modified by anyone. Please retain references
to Richard Maley at Advanced Delphi Systems. If you make improvements to the
code please send your improvements to maley@advdelphisys.com so that the
entire Delphi community can benefit. All comments are welcome.
}
(*
Description: ads_DlgMemo.pas.pas
This unit contains
*)
(*UnitIndex Master Index Implementation Section Download UnitsDescription: ads_DlgMemo.pas This unit contains the following routines.
DlgMemo_ads TfrmMemo.btnCancelClick TfrmMemo.btnOKClick TfrmMemo.FormCreate TfrmMemo.FormResize TfrmMemo.GetDisplayLabel TfrmMemo.GetModified TfrmMemo.GetPlainText TfrmMemo.GetPostChanges TfrmMemo.GetReadOnly TfrmMemo.GetText TfrmMemo.GetTitle TfrmMemo.GetWordWrap TfrmMemo.SetDisplayLabel TfrmMemo.SetPlainText TfrmMemo.SetReadOnly TfrmMemo.SetText TfrmMemo.SetTitle TfrmMemo.SetWordWrap
*)
interface
{!~DlgMemo_ads
}
Function DlgMemo_ads (
Const DisplayLabel : String;
Const PlainText : Boolean;
Const ReadOnly : Boolean;
var Text : String;
Const Title : String;
const WordWrap : Boolean
): Boolean;
implementation
Uses
ads_GraphicStrings,
ads_Exception,
Windows,
Messages,
SysUtils,
Classes,
Graphics,
Controls,
Forms,
Dialogs,
StdCtrls,
Buttons,
ComCtrls,
ExtCtrls
;
Var
UnitName : String = 'ads_DlgMemo';
ProcName : String = 'Unknown';
type
TfrmMemo = Class(TScrollingWinControl)
Public
Constructor Create(AOwner: TComponent); Override;
Destructor Destroy; Override;
Public
pnlBase : TPanel;
pnlMemo : TPanel;
pnlButtons : TPanel;
pnlTop : TPanel;
pnlButtonsSlider: TPanel;
Memo : TRichEdit;
btnOK : TBitBtn;
btnCancel : TBitBtn;
procedure FormCreate(Sender: TObject);
procedure btnCancelClick(Sender: TObject);
procedure btnOKClick(Sender: TObject);
procedure FormResize(Sender: TObject);
private
{ Private declarations }
FTextBefore : String;
FPostChanges : Boolean;
function GetModified: Boolean;
function GetPlainText: Boolean;
function GetPostChanges: Boolean;
function GetReadOnly: Boolean;
function GetText: String;
function GetTitle: String;
function GetWordWrap: Boolean;
procedure SetPlainText(const Value: Boolean);
procedure SetReadOnly(const Value: Boolean);
procedure SetText(const Value: String);
procedure SetTitle(const Value: String);
procedure SetWordWrap(const Value: Boolean);
function GetDisplayLabel: String;
procedure SetDisplayLabel(const Value: String);
public
{ Public declarations }
property DisplayLabel : String Read GetDisplayLabel write SetDisplayLabel;
property Modified : Boolean read GetModified;
property PlainText : Boolean read GetPlainText write SetPlainText;
property PostChanges : Boolean read GetPostChanges;
property ReadOnly : Boolean read GetReadOnly write SetReadOnly;
property Text : String read GetText write SetText;
property Title : String read GetTitle write SetTitle;
property WordWrap : Boolean read GetWordWrap write SetWordWrap;
end;
{ TfrmMemo }
//Unit Description UnitIndex Master Indexfunction TfrmMemo.GetModified: Boolean; begin Result := False; ProcName := 'TfrmMemo.GetModified'; Try Result := (FTextBefore <> Memo.Lines.Text); Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; end; //Unit Description UnitIndex Master Index
function TfrmMemo.GetPlainText: Boolean; begin Result := Memo.PlainText; ProcName := 'TfrmMemo.GetPlainText'; Try Result := Memo.PlainText; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; end; //Unit Description UnitIndex Master Index
function TfrmMemo.GetReadOnly: Boolean; begin Result := False; ProcName := 'TfrmMemo.GetReadOnly'; Try Result := Memo.ReadOnly; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; end; //Unit Description UnitIndex Master Index
function TfrmMemo.GetText: String; begin ProcName := 'TfrmMemo.GetText'; Try Result := Memo.Lines.Text; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; end; //Unit Description UnitIndex Master Index
function TfrmMemo.GetTitle: String; begin ProcName := 'TfrmMemo.GetTitle'; Try Result := Self.Caption; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; end; //Unit Description UnitIndex Master Index
function TfrmMemo.GetWordWrap: Boolean; begin Result := True; ProcName := 'TfrmMemo.GetWordWrap'; Try Result := Memo.WordWrap; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; end; //Unit Description UnitIndex Master Index
procedure TfrmMemo.SetPlainText(const Value: Boolean); begin ProcName := 'TfrmMemo.SetPlainText'; Try If Memo.PlainText <> Value Then Memo.PlainText := Value; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; end; //Unit Description UnitIndex Master Index
procedure TfrmMemo.SetReadOnly(const Value: Boolean); begin ProcName := 'TfrmMemo.SetReadOnly'; Try If Memo.ReadOnly <> Value Then Memo.ReadOnly := Value; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; end; //Unit Description UnitIndex Master Index
procedure TfrmMemo.SetText(const Value: String);
Var
sgText : String;
begin
ProcName := 'TfrmMemo.SetText'; Try
sgText := Value;
If sgText <> Memo.Lines.Text Then
Begin
FPostChanges := False;
Memo.Lines.SetText(PChar(Value));
FTextBefore := Memo.Lines.Text;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
//Unit Description UnitIndex Master Indexprocedure TfrmMemo.SetTitle(const Value: String); begin ProcName := 'TfrmMemo.SetTitle'; Try If Self.Caption <> Value Then Self.Caption := Value; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; end; //Unit Description UnitIndex Master Index
procedure TfrmMemo.SetWordWrap(const Value: Boolean); begin ProcName := 'TfrmMemo.SetWordWrap'; Try If Memo.WordWrap <> Value Then Memo.WordWrap := Value; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; end; //Unit Description UnitIndex Master Index
procedure TfrmMemo.FormCreate(Sender: TObject); begin ProcName := 'TfrmMemo.FormCreate'; Try FTextBefore := ''; FPostChanges := False; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; end; //Unit Description UnitIndex Master Index
procedure TfrmMemo.btnCancelClick(Sender: TObject); begin ProcName := 'TfrmMemo.btnCancelClick'; Try Memo.Lines.SetText(PChar(FTextBefore)); FPostChanges := False; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; end; //Unit Description UnitIndex Master Index
function TfrmMemo.GetPostChanges: Boolean; begin Result := False; ProcName := 'TfrmMemo.GetPostChanges'; Try Result := FPostChanges; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; end; //Unit Description UnitIndex Master Index
procedure TfrmMemo.btnOKClick(Sender: TObject); begin ProcName := 'TfrmMemo.btnOKClick'; Try FPostChanges := False; If ReadOnly Then Exit; If Not Modified Then Exit; FPostChanges := True; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; end; //Unit Description UnitIndex Master Index
function TfrmMemo.GetDisplayLabel: String; begin ProcName := 'TfrmMemo.GetDisplayLabel'; Try Result := pnlTop.Caption; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; end; //Unit Description UnitIndex Master Index
procedure TfrmMemo.SetDisplayLabel(const Value: String); begin ProcName := 'TfrmMemo.SetDisplayLabel'; Try If pnlTop.Caption <> Value Then pnlTop.Caption := Value; Except On E : Exception Do RaiseError(UnitName,ProcName,E); End; end; //Unit Description UnitIndex Master Index
procedure TfrmMemo.FormResize(Sender: TObject);
begin
ProcName := 'TfrmMemo.FormResize'; Try
If Self.Height < 200 Then Self.Height := 200;
If Self.Width < 200 Then Self.Width := 200;
pnlButtonsSlider.Width := pnlButtonsSlider.Width + 1;
pnlButtonsSlider.Width := pnlButtonsSlider.Width - 1;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
Constructor TfrmMemo.Create(AOwner: TComponent);
Function IsControl(Obj: TObject): Boolean;
Begin
Result := (Obj is TControl);
End;
Begin
ProcName := 'TfrmMemo.Create'; Try
inherited;
Self.Parent := TWincontrol(AOwner);
pnlBase := TPanel.Create(AOwner);
With pnlBase Do
Begin
If IsControl(pnlBase) Then
Begin
Parent := Self;
End;
Left := 0;
Top := 0;
Width := 775;
Height := 513;
Align := alClient;
BevelOuter := bvNone;
BorderWidth := 5;
Caption := ' ';
TabOrder := 0;
End;
pnlMemo := TPanel.Create(AOwner);
With pnlMemo Do
Begin
Parent := pnlBase;
Left := 5;
Top := 25;
Width := 765;
Height := 441;
Align := alClient;
BevelOuter := bvNone;
BorderWidth := 5;
Caption := ' ';
TabOrder := 0;
End;
Memo := TRichEdit.Create(AOwner);
With Memo Do
Begin
Parent := pnlMemo;
Left := 5;
Top := 5;
Width := 755;
Height := 431;
Align := alClient;
BorderStyle := bsNone;
PlainText := True;
TabOrder := 0;
End;
pnlButtons := TPanel.Create(AOwner);
With pnlButtons Do
Begin
Parent := pnlBase;
Left := 5;
Top := 466;
Width := 765;
Height := 42;
Align := alBottom;
BevelOuter := bvNone;
BorderWidth := 5;
Caption := ' ';
TabOrder := 1;
End;
pnlButtonsSlider := TPanel.Create(AOwner);
With pnlButtonsSlider Do
Begin
Parent := pnlButtons;
Left := 596;
Top := 5;
Width := 164;
Height := 32;
Align := alRight;
BevelOuter := bvNone;
Caption := ' ';
TabOrder := 0;
End;
btnOK := TBitBtn.Create(AOwner);
With btnOK Do
Begin
Parent := pnlButtonsSlider;
Left := 2;
Top := 0;
Width := 75;
Height := 25;
TabOrder := 0;
OnClick := btnOKClick;
Kind := bkOK;
End;
btnCancel := TBitBtn.Create(AOwner);
With btnCancel Do
Begin
Parent := pnlButtonsSlider;
Left := 83;
Top := 0;
Width := 75;
Height := 25;
TabOrder := 1;
OnClick := btnCancelClick;
Kind := bkCancel;
End;
pnlTop := TPanel.Create(AOwner);
With pnlTop Do
Begin
Parent := pnlBase;
Left := 5;
Top := 5;
Width := 765;
Height := 20;
Align := alTop;
Alignment := taLeftJustify;
BevelOuter := bvNone;
BorderWidth := 5;
Caption := 'Notes:';
TabOrder := 2;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
Destructor TfrmMemo.Destroy;
Begin
ProcName := 'TfrmMemo.Destroy'; Try
pnlTop .Free;
btnCancel .Free;
btnOK .Free;
pnlButtonsSlider.Free;
pnlButtons .Free;
Memo .Free;
pnlMemo .Free;
pnlBase .Free;
inherited Destroy;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
{!~DlgMemo_ads
}
//Unit Description UnitIndex Master Index
Function DlgMemo_ads (
Const DisplayLabel : String;
Const PlainText : Boolean;
Const ReadOnly : Boolean;
var Text : String;
Const Title : String;
const WordWrap : Boolean
): Boolean;
Var
Dialog : TForm;
Form : TfrmMemo;
Begin
Result := False;
Dialog := nil;
ProcName := 'DlgMemo_ads'; Try
Try
Dialog := TForm.Create(nil);
Form := TfrmMemo.Create(Dialog);
Form.Parent:= Dialog;
Form.Align := alClient;
With Dialog Do
Begin
Left := 295;
Top := 106;
Width := 783;
Height := 540;
BorderIcons := [biSystemMenu, biMaximize];
Color := clBtnFace;
Font.Color := clWindowText;
Font.Height := -11;
Font.Name := 'MS Sans Serif';
Font.Style := [];
OldCreateOrder:= False;
Position := poScreenCenter;
OnCreate := Form.FormCreate;
OnResize := Form.FormResize;
PixelsPerInch := 96;
End;
Form.FormCreate(Dialog);
Form.FormCreate(Dialog);
Form.DisplayLabel := DisplayLabel;
Form.PlainText := PlainText;
Form.ReadOnly := ReadOnly;
Form.Text := Text;
Form.Title := Title;
Form.WordWrap := WordWrap;
Form.Parent := Dialog;
Dialog.ShowModal;
Text := Form.Text;
Result := Form.PostChanges;
Finally
Dialog.Free;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
End.
//