home *** CD-ROM | disk | FTP | other *** search
- unit msDBMemo;
-
- interface
-
- uses
- Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
- StdCtrls, DBCtrls, DB, DBTables, ShowMemo;
-
- type
- TMSMemo = class(TDBMemo)
- private
- FShowMemoTitle : String;
- // FPlainText : Boolean;
- procedure ShowMemo(tblMemo : TTable; sFieldName, sHeading : String ; lReadOnlyFlag : Boolean; sFontName : String; nFontSize : Integer);
- protected
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- procedure dblclick(Sender : TObject);
- published
- property ShowMemoTitle : String read FShowMemoTitle write FShowMemoTitle;
- end;
-
- procedure Register;
-
- implementation
-
- constructor TMSMemo.Create(AOwner: TComponent);
- begin
- inherited Create(AOwner);
- OnDblClick := DblClick;
- Font.Name := 'Courier New';
- Font.Size := 10;
- end;
-
- destructor TMSMemo.Destroy;
- begin
- inherited Destroy;
- if (Application.FindComponent('FrmShowMemo') <> nil) then begin
- FrmShowMemo.Close;
- FrmShowMemo := nil;
- end;
- end;
-
- procedure TMSMemo.dblclick(Sender: TObject);
- var
- sFontName : String;
- nFontSize : Integer;
- begin
- sFontName := Font.Name;
- nFontSize := Font.Size;
- Self.Perform(CM_EXIT,0,1);
- ShowMemo(TTable(TDataSource(TMSMemo(Self).DataSource).DataSet),TDBMemo(Self).DataField,ShowMemoTitle,TMSMemo(Self).ReadOnly, sFontName, nFontSize);
- end;
-
- procedure TMSMemo.ShowMemo(tblMemo : TTable; sFieldName, sHeading : String ; lReadOnlyFlag : Boolean; sFontName : String; nFontSize : Integer);
- begin
- if (Application.FindComponent('FrmShowMemo') = nil) then
- Application.CreateForm(TFrmShowMemo, FrmShowMemo);
- if lReadOnlyFlag then
- sHeading := sHeading + ' - [Read Only]';
- FrmShowMemo.Caption := sHeading;
- FrmShowMemo.SrcMemo.DataSet := tblMemo;
- FrmShowMemo.DBMemo.DataField := sFieldName;
- FrmShowMemo.DBMemo.ReadOnly := lReadOnlyFlag;
- frmShowMemo.DBMemo.Font.Name := sFontName;
- frmShowMemo.DBMemo.Font.Size := nFontSize;
- FrmShowMemo.ShowModal;
- { if FrmShowMemo.ShowModal = mrOk then
- begin
- Font.Name := sFontName;
- Font.Size := nFontSize;
- Result := True;
- end
- else
- begin
- Font.Name := sFontName;
- Font.Size := nFontSize;
- Result := False;
- end;}
- end;
-
- procedure Register;
- begin
- RegisterComponents('msTOOLS', [TMSMemo]);
- end;
-
- end.
-