Bu unit program memo dialog işleminde kullanılır.
Kod: Tümünü seç
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
*)
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 }
function 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;
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;
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;
function TfrmMemo.GetText: String;
begin
ProcName := 'TfrmMemo.GetText'; Try
Result := Memo.Lines.Text;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
function TfrmMemo.GetTitle: String;
begin
ProcName := 'TfrmMemo.GetTitle'; Try
Result := Self.Caption;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
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;
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;
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;
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;
procedure 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;
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;
procedure TfrmMemo.FormCreate(Sender: TObject);
begin
ProcName := 'TfrmMemo.FormCreate'; Try
FTextBefore := '';
FPostChanges := False;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
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;
function TfrmMemo.GetPostChanges: Boolean;
begin
Result := False;
ProcName := 'TfrmMemo.GetPostChanges'; Try
Result := FPostChanges;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
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;
function TfrmMemo.GetDisplayLabel: String;
begin
ProcName := 'TfrmMemo.GetDisplayLabel'; Try
Result := pnlTop.Caption;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
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;
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
}
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.