Bu unit program database memo nesnesi dialog işleminde kullanılır.
Kod: Tümünü seç
unit ads_DlgDBMemo;
{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_DlgDBMemo.pas.pas
This unit contains
*)
interface
Uses DB, Graphics, Controls;
Function DlgDBMemo_ads (
DataField : String;
DataLabel : String;
DataSource : TDataSource;
MinHeight : Integer;
MinWidth : Integer;
PlainText : Boolean;
ReadOnly : Boolean;
TitleOfWindow : String;
WordWrap : Boolean
)
: Boolean;
{!~DlgDBMemoDetail_ads
}
Function DlgDBMemoDetail_ads (
Border : Boolean;
DataField : String;
DataLabel : String;
DataSource : TDataSource;
DragMovable : Boolean;
DragResizable : Boolean;
FileName : String;
FontColor : TColor;
FontName : TFontName;
FontSize : Integer;
MinHeight : Integer;
MinWidth : Integer;
Modal : Boolean;
ParentControl : TWinControl;
PlainText : Boolean;
PopupEnabled : Boolean;
ReadOnly : Boolean;
ShowNavCancel : Boolean;
ShowNavDelete : Boolean;
ShowNavEdit : Boolean;
ShowNavFirst : Boolean;
ShowNavigator : Boolean;
ShowNavInsert : Boolean;
ShowNavLast : Boolean;
ShowNavNext : Boolean;
ShowNavPost : Boolean;
ShowNavPrior : Boolean;
ShowNavRefresh : Boolean;
StayOnTop : Boolean;
TitleOfWindow : String;
WordWrap : Boolean
)
: Boolean;
implementation
Uses
ads_GraphicStrings,
Forms,
StdCtrls,
ComCtrls,
DBCtrls,
ExtCtrls,
Classes,
SysUtils,
ads_Exception,
Menus,
ActnList,
ImgList,
Windows,
Dialogs,
Buttons
;
Var
UnitName : String;
ProcName : String;
type
TDBMemo_ads = Class(TScrollingWinControl)
Public
Constructor Create(AOwner: TComponent); Override;
Destructor Destroy; Override;
Public
pnlBase : TPanel;
nav : TDBNavigator;
DBMemo : TDBRichEdit;
pnlTitle : TPanel;
mnu : TPopupMenu;
Navigator1 : TMenuItem;
ActionList : TActionList;
NavigatorShow : TAction;
ActionNavShowCancel : TAction;
ActionNavShowDelete : TAction;
ActionNavShowEdit : TAction;
ActionNavShowPost : TAction;
ActionNavShowRefresh : TAction;
ActionNavShowInsert : TAction;
ActionNavShowFirst : TAction;
ActionNavShowPrior : TAction;
ActionNavShowNext : TAction;
ActionNavShowLast : TAction;
ImageList : TImageList;
ActionMemoWordWrap : TAction;
Navigator2 : TMenuItem;
N1 : TMenuItem;
ShowCancel1 : TMenuItem;
ShowDelete1 : TMenuItem;
ShowEdit1 : TMenuItem;
ShowInsert1 : TMenuItem;
ShowPost1 : TMenuItem;
ShowRefresh1 : TMenuItem;
N2 : TMenuItem;
HideFirst1 : TMenuItem;
HidePrior1 : TMenuItem;
HideNext1 : TMenuItem;
HideLast1 : TMenuItem;
Memo1 : TMenuItem;
TurnWordwrapOff1 : TMenuItem;
ActionMemoPlainText : TAction;
ActionAppearanceBorder : TAction;
ActionAppearanceMovable : TAction;
ActionAppearanceResize : TAction;
ActionMemoReadOnly : TAction;
TurnPlainTextOn1 : TMenuItem;
TurnReadOnlyOn1 : TMenuItem;
ActionAppearanceFont : TAction;
FontDialog : TFontDialog;
Appearance1 : TMenuItem;
HideBorder1 : TMenuItem;
Font1 : TMenuItem;
TurnMovingOff1 : TMenuItem;
TurnResizingOff1 : TMenuItem;
ActionAppearanceSendToBack : TAction;
ActionAppearanceBringToFront : TAction;
BringToFront1 : TMenuItem;
SendToBack1 : TMenuItem;
pnlButtonsBase: TPanel;
pnlButtonsSlider: TPanel;
btnCancel: TBitBtn;
btnOK: TBitBtn;
procedure FormCreate (Sender: TObject);
procedure FormResize (Sender: TObject);
procedure pnlBaseMouseDown (Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure pnlBaseMouseUp (Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure NavigatorShowExecute (Sender: TObject);
procedure ActionNavShowCancelExecute (Sender: TObject);
procedure ActionNavShowDeleteExecute (Sender: TObject);
procedure ActionNavShowEditExecute (Sender: TObject);
procedure ActionNavShowPostExecute (Sender: TObject);
procedure ActionNavShowRefreshExecute (Sender: TObject);
procedure ActionNavShowInsertExecute (Sender: TObject);
procedure ActionNavShowFirstExecute (Sender: TObject);
procedure ActionNavShowPriorExecute (Sender: TObject);
procedure ActionNavShowNextExecute (Sender: TObject);
procedure ActionNavShowLastExecute (Sender: TObject);
procedure ActionMemoWordWrapExecute (Sender: TObject);
procedure ActionMemoPlainTextExecute (Sender: TObject);
procedure DBMemoMouseDown (Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ActionMemoReadOnlyExecute (Sender: TObject);
procedure ActionAppearanceFontExecute (Sender: TObject);
procedure ActionAppearanceBorderExecute (Sender: TObject);
procedure ActionAppearanceMovableExecute (Sender: TObject);
procedure ActionAppearanceResizeExecute (Sender: TObject);
procedure ActionAppearanceBringToFrontExecute(Sender: TObject);
procedure ActionAppearanceSendToBackExecute (Sender: TObject);
procedure btnOKClick(Sender: TObject);
procedure btnCancelClick(Sender: TObject);
private
{ Private declarations }
FBorder : Boolean;
FCursorWas : TCursor;
FDataField : String;
FDataLabel : String;
FDataSource : TDataSource;
FDragging : Boolean;
FDragMovable : Boolean;
FDragResizable : Boolean;
FDragResizing : Boolean;
FDragStartX : Integer;
FDragStartY : Integer;
FFileName : String;
FFontColor : TColor;
FFontName : TFontName;
FFontSize : Integer;
FMinHeight : Integer;
FMinWidth : Integer;
FModal : Boolean;
FParentControl : TWinControl;
FPlainText : Boolean;
FPopupEnabled : Boolean;
FReadOnly : Boolean;
FShowNavCancel : Boolean;
FShowNavDelete : Boolean;
FShowNavEdit : Boolean;
FShowNavFirst : Boolean;
FShowNavigator : Boolean;
FShowNavInsert : Boolean;
FShowNavLast : Boolean;
FShowNavNext : Boolean;
FShowNavPost : Boolean;
FShowNavPrior : Boolean;
FShowNavRefresh : Boolean;
FStayOnTop : Boolean;
FTitleOfWindow : String;
FWordWrap : Boolean;
Function IsObject (Obj : TObject; Cls : TClass): Boolean;
procedure SetBorder (const Value: Boolean);
procedure SetDataField (const Value: String);
procedure SetDataLabel (const Value: String);
procedure SetDataSource (const Value: TDataSource);
procedure SetDragMovable (const Value: Boolean);
procedure SetDragResizable (const Value: Boolean);
procedure SetFileName (const Value: String);
procedure SetFontColor (const Value: TColor);
procedure SetFontName (const Value: TFontName);
procedure SetFontSize (const Value: Integer);
procedure SetMinHeight (const Value: Integer);
procedure SetMinWidth (const Value: Integer);
procedure SetModal (const Value: Boolean);
procedure SetNavButton (nav : TDBNavigator;btn : TButtonSet;Included : Boolean);
procedure SetParentControl ( Value: TWinControl);
procedure SetPlainText (const Value: Boolean);
procedure SetPopupEnabled (const Value: Boolean);
procedure SetReadOnly (const Value: Boolean);
procedure SetShowNavCancel (const Value: Boolean);
procedure SetShowNavDelete (const Value: Boolean);
procedure SetShowNavEdit (const Value: Boolean);
procedure SetShowNavFirst (const Value: Boolean);
procedure SetShowNavigator (const Value: Boolean);
procedure SetShowNavInsert (const Value: Boolean);
procedure SetShowNavLast (const Value: Boolean);
procedure SetShowNavNext (const Value: Boolean);
procedure SetShowNavPost (const Value: Boolean);
procedure SetShowNavPrior (const Value: Boolean);
procedure SetShowNavRefresh (const Value: Boolean);
procedure SetStayOnTop (const Value: Boolean);
procedure SetTitleOfWindow (const Value: String);
procedure SetWordWrap (const Value: Boolean);
function GetOnMemoChange : TNotifyEvent;
function GetOnMemoClick : TNotifyEvent;
function GetOnMemoDblClick : TNotifyEvent;
function GetOnMemoDragDrop : TDragDropEvent;
function GetOnMemoDragOver : TDragOverEvent;
function GetOnMemoEndDock : TEndDragEvent;
function GetOnMemoEndDrag : TEndDragEvent;
function GetOnMemoEnter : TNotifyEvent;
function GetOnMemoExit : TNotifyEvent;
function GetOnMemoKeyDown : TKeyEvent;
function GetOnMemoKeyPress : TKeyPressEvent;
function GetOnMemoKeyUp : TKeyEvent;
function GetOnMemoMouseDown : TMouseEvent;
function GetOnMemoMouseMove : TMouseMoveEvent;
function GetOnMemoMouseUp : TMouseEvent;
function GetOnMemoProtectChange : TRichEditProtectChange;
function GetOnMemoResizeRequest : TRichEditResizeEvent;
function GetOnMemoSaveClipboard : TRichEditSaveClipboard;
function GetOnMemoSelectionChange : TNotifyEvent;
function GetOnMemoStartDock : TStartDockEvent;
function GetOnMemoStartDrag : TStartDragEvent;
procedure SetOnMemoChange (const Value: TNotifyEvent);
procedure SetOnMemoClick (const Value: TNotifyEvent);
procedure SetOnMemoDblClick (const Value: TNotifyEvent);
procedure SetOnMemoDragDrop (const Value: TDragDropEvent);
procedure SetOnMemoDragOver (const Value: TDragOverEvent);
procedure SetOnMemoEndDock (const Value: TEndDragEvent);
procedure SetOnMemoEndDrag (const Value: TEndDragEvent);
procedure SetOnMemoEnter (const Value: TNotifyEvent);
procedure SetOnMemoExit (const Value: TNotifyEvent);
procedure SetOnMemoKeyDown (const Value: TKeyEvent);
procedure SetOnMemoKeyPress (const Value: TKeyPressEvent);
procedure SetOnMemoKeyUp (const Value: TKeyEvent);
procedure SetOnMemoMouseDown (const Value: TMouseEvent);
procedure SetOnMemoMouseMove (const Value: TMouseMoveEvent);
procedure SetOnMemoMouseUp (const Value: TMouseEvent);
procedure SetOnMemoProtectChange (const Value: TRichEditProtectChange);
procedure SetOnMemoResizeRequest (const Value: TRichEditResizeEvent);
procedure SetOnMemoSaveClipboard (const Value: TRichEditSaveClipboard);
procedure SetOnMemoSelectionChange (const Value: TNotifyEvent);
procedure SetOnMemoStartDock (const Value: TStartDockEvent);
procedure SetOnMemoStartDrag (const Value: TStartDragEvent);
public
{ Public declarations }
procedure SaveToFile;
{ Published declarations }
property Border : Boolean read FBorder write SetBorder;
property DataField : String read FDataField write SetDataField;
property DataLabel : String read FDataLabel write SetDataLabel;
property DataSource : TDataSource read FDataSource write SetDataSource;
property DragMovable : Boolean read FDragMovable write SetDragMovable;
property DragResizable : Boolean read FDragResizable write SetDragResizable;
property FileName : String read FFileName write SetFileName;
property FontColor : TColor read FFontColor write SetFontColor;
property FontName : TFontName read FFontName write SetFontName;
property FontSize : Integer read FFontSize write SetFontSize;
property MinHeight : Integer read FMinHeight write SetMinHeight;
property MinWidth : Integer read FMinWidth write SetMinWidth;
property Modal : Boolean read FModal write SetModal;
property ParentControl : TWinControl read FParentControl write SetParentControl;
property PlainText : Boolean read FPlainText write SetPlainText;
property PopupEnabled : Boolean read FPopupEnabled write SetPopupEnabled;
property ReadOnly : Boolean read FReadOnly write SetReadOnly;
property ShowNavCancel : Boolean read FShowNavCancel write SetShowNavCancel;
property ShowNavDelete : Boolean read FShowNavDelete write SetShowNavDelete;
property ShowNavEdit : Boolean read FShowNavEdit write SetShowNavEdit;
property ShowNavFirst : Boolean read FShowNavFirst write SetShowNavFirst;
property ShowNavigator : Boolean read FShowNavigator write SetShowNavigator;
property ShowNavInsert : Boolean read FShowNavInsert write SetShowNavInsert;
property ShowNavLast : Boolean read FShowNavLast write SetShowNavLast;
property ShowNavNext : Boolean read FShowNavNext write SetShowNavNext;
property ShowNavPost : Boolean read FShowNavPost write SetShowNavPost;
property ShowNavPrior : Boolean read FShowNavPrior write SetShowNavPrior;
property ShowNavRefresh : Boolean read FShowNavRefresh write SetShowNavRefresh;
property StayOnTop : Boolean read FStayOnTop write SetStayOnTop;
property TitleOfWindow : String read FTitleOfWindow write SetTitleOfWindow;
property WordWrap : Boolean read FWordWrap write SetWordWrap;
property OnMemoChange : TNotifyEvent read GetOnMemoChange write SetOnMemoChange;
property OnMemoClick : TNotifyEvent read GetOnMemoClick write SetOnMemoClick;
property OnMemoDblClick : TNotifyEvent read GetOnMemoDblClick write SetOnMemoDblClick;
property OnMemoDragDrop : TDragDropEvent read GetOnMemoDragDrop write SetOnMemoDragDrop;
property OnMemoDragOver : TDragOverEvent read GetOnMemoDragOver write SetOnMemoDragOver;
property OnMemoEndDock : TEndDragEvent read GetOnMemoEndDock write SetOnMemoEndDock;
property OnMemoEndDrag : TEndDragEvent read GetOnMemoEndDrag write SetOnMemoEndDrag;
property OnMemoEnter : TNotifyEvent read GetOnMemoEnter write SetOnMemoEnter;
property OnMemoExit : TNotifyEvent read GetOnMemoExit write SetOnMemoExit;
property OnMemoKeyDown : TKeyEvent read GetOnMemoKeyDown write SetOnMemoKeyDown;
property OnMemoKeyPress : TKeyPressEvent read GetOnMemoKeyPress write SetOnMemoKeyPress;
property OnMemoKeyUp : TKeyEvent read GetOnMemoKeyUp write SetOnMemoKeyUp;
property OnMemoMouseDown : TMouseEvent read GetOnMemoMouseDown write SetOnMemoMouseDown;
property OnMemoMouseMove : TMouseMoveEvent read GetOnMemoMouseMove write SetOnMemoMouseMove;
property OnMemoMouseUp : TMouseEvent read GetOnMemoMouseUp write SetOnMemoMouseUp;
property OnMemoProtectChange : TRichEditProtectChange read GetOnMemoProtectChange write SetOnMemoProtectChange;
property OnMemoResizeRequest : TRichEditResizeEvent read GetOnMemoResizeRequest write SetOnMemoResizeRequest;
property OnMemoSaveClipboard : TRichEditSaveClipboard read GetOnMemoSaveClipboard write SetOnMemoSaveClipboard;
property OnMemoSelectionChange : TNotifyEvent read GetOnMemoSelectionChange write SetOnMemoSelectionChange;
property OnMemoStartDock : TStartDockEvent read GetOnMemoStartDock write SetOnMemoStartDock;
property OnMemoStartDrag : TStartDragEvent read GetOnMemoStartDrag write SetOnMemoStartDrag;
end;
{ TDBMemo_ads }
procedure TDBMemo_ads.SetDataField(const Value: String);
begin
ProcName := 'TDBMemo_ads.SetDataField'; Try
FDataField := Value;
DBMemo.DataField := FDataField;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.SetDataSource(const Value: TDataSource);
begin
ProcName := 'TDBMemo_ads.SetDataSource'; Try
FDataSource := Value;
DBMemo.DataSource := Value;
nav.DataSource := Value;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.SetFontColor(const Value: TColor);
begin
ProcName := 'TDBMemo_ads.SetFontColor'; Try
FFontColor := Value;
DBMemo.Font.Color := Value;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.SetFontName(const Value: TFontName);
begin
ProcName := 'TDBMemo_ads.SetFontName'; Try
FFontName := Value;
DBMemo.Font.Name := Value;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.SetFontSize(const Value: Integer);
begin
ProcName := 'TDBMemo_ads.SetFontSize'; Try
FFontSize := Value;
DBMemo.Font.Size := Value;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.SetPlainText(const Value: Boolean);
begin
ProcName := 'TDBMemo_ads.SetPlainText'; Try
FPlainText := Value;
DBMemo.PlainText := Value;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.SetReadOnly(const Value: Boolean);
begin
ProcName := 'TDBMemo_ads.SetReadOnly'; Try
FReadOnly := Value;
DBMemo.ReadOnly := Value;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.SetShowNavCancel(const Value: Boolean);
begin
ProcName := 'TDBMemo_ads.SetShowNavCancel'; Try
FShowNavCancel := Value;
SetNavButton(nav,[nbCancel],Value);
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.SetShowNavDelete(const Value: Boolean);
begin
ProcName := 'TDBMemo_ads.SetShowNavDelete'; Try
FShowNavDelete := Value;
SetNavButton(nav,[nbDelete],Value);
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.SetShowNavEdit(const Value: Boolean);
begin
ProcName := 'TDBMemo_ads.SetShowNavEdit'; Try
FShowNavEdit := Value;
SetNavButton(nav,[nbEdit],Value);
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.SetShowNavFirst(const Value: Boolean);
begin
ProcName := 'TDBMemo_ads.SetShowNavFirst'; Try
FShowNavFirst := Value;
SetNavButton(nav,[nbFirst],Value);
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.SetShowNavigator(const Value: Boolean);
begin
ProcName := 'TDBMemo_ads.SetShowNavigator'; Try
FShowNavigator := Value;
nav.Visible := Value;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.SetShowNavInsert(const Value: Boolean);
begin
ProcName := 'TDBMemo_ads.SetShowNavInsert'; Try
FShowNavInsert := Value;
SetNavButton(nav,[nbInsert],Value);
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.SetShowNavLast(const Value: Boolean);
begin
ProcName := 'TDBMemo_ads.SetShowNavLast'; Try
FShowNavLast := Value;
SetNavButton(nav,[nbLast],Value);
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.SetShowNavNext(const Value: Boolean);
begin
ProcName := 'TDBMemo_ads.SetShowNavNext'; Try
FShowNavNext := Value;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.SetShowNavPost(const Value: Boolean);
begin
ProcName := 'TDBMemo_ads.SetShowNavPost'; Try
FShowNavPost := Value;
SetNavButton(nav,[nbPost],Value);
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.SetShowNavPrior(const Value: Boolean);
begin
ProcName := 'TDBMemo_ads.SetShowNavPrior'; Try
FShowNavPrior := Value;
SetNavButton(nav,[nbPrior],Value);
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.SetShowNavRefresh(const Value: Boolean);
begin
ProcName := 'TDBMemo_ads.SetShowNavRefresh'; Try
FShowNavRefresh := Value;
SetNavButton(nav,[nbRefresh],Value);
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.SetWordWrap(const Value: Boolean);
begin
ProcName := 'TDBMemo_ads.SetWordWrap'; Try
FWordWrap := Value;
DBMemo.WordWrap := Value;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.FormCreate(Sender: TObject);
begin
ProcName := 'TDBMemo_ads.FormCreate'; Try
Border := True;
DataField := '';
DataLabel := '';
DataSource := nil;
DragMovable := True;
DragResizable := True;
FileName := '';
FontColor := clWindowText;
FontName := 'MS Sans Serif';
FontSize := 8;
MinHeight := 150;
MinWidth := 200;
Modal := True;
PlainText := False;
PopupEnabled := True;
ReadOnly := False;
ShowNavCancel := False;
ShowNavDelete := False;
ShowNavEdit := False;
ShowNavFirst := True;
ShowNavigator := False;
ShowNavInsert := False;
ShowNavLast := True;
ShowNavNext := True;
ShowNavPost := False;
ShowNavPrior := True;
ShowNavRefresh := False;
StayOnTop := False;
TitleOfWindow := 'Memo Dialog';
WordWrap := True;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.SetModal(const Value: Boolean);
begin
ProcName := 'TDBMemo_ads.SetModal'; Try
FModal := Value;
If FModal Then
Begin
ParentControl := nil;
TForm(Owner).BorderStyle := bsSizeable;
TForm(Owner).BorderIcons := [biSystemMenu];
End
Else
Begin
TForm(Owner).BorderStyle := bsNone;
TForm(Owner).BorderIcons := [];
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.SetMinHeight(const Value: Integer);
begin
ProcName := 'TDBMemo_ads.SetMinHeight'; Try
FMinHeight := Value;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.SetMinWidth(const Value: Integer);
begin
ProcName := 'TDBMemo_ads.SetMinWidth'; Try
FMinWidth := Value;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.FormResize(Sender: TObject);
begin
ProcName := 'TDBMemo_ads.FormResize'; Try
If Width < MinWidth Then Width := MinWidth;
If Height < MinHeight Then Height := MinHeight;
pnlButtonsBase.Height := pnlButtonsBase.Height + 1;
pnlButtonsBase.Height := pnlButtonsBase.Height - 1;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.SetNavButton(nav : TDBNavigator;btn : TButtonSet;Included : Boolean);
Var
btnsNow : TButtonSet;
btnsCur : TButtonSet;
btnsNew : TButtonSet;
navbtn : TNavigateBtn;
Begin
ProcName := 'TDBMemo_ads.SetNavButton'; Try
btnsNow := nav.VisibleButtons;
btnsCur := [];
navbtn := nbFirst;
If nbFirst in btn Then Begin navBtn := nbFirst; btnsCur := [nbFirst]; End;
If nbPrior in btn Then Begin navBtn := nbPrior; btnsCur := [nbPrior]; End;
If nbNext in btn Then Begin navBtn := nbNext; btnsCur := [nbNext]; End;
If nbLast in btn Then Begin navBtn := nbLast; btnsCur := [nbLast]; End;
If nbInsert in btn Then Begin navBtn := nbInsert; btnsCur := [nbInsert]; End;
If nbDelete in btn Then Begin navBtn := nbDelete; btnsCur := [nbDelete]; End;
If nbEdit in btn Then Begin navBtn := nbEdit; btnsCur := [nbEdit]; End;
If nbPost in btn Then Begin navBtn := nbPost; btnsCur := [nbPost]; End;
If nbCancel in btn Then Begin navBtn := nbCancel; btnsCur := [nbCancel]; End;
If nbRefresh in btn Then Begin navBtn := nbRefresh;btnsCur := [nbRefresh]; End;
btnsNew := [];
If Included Then
Begin
If Not (navBtn in btnsNow) Then
Begin
btnsNew := btnsNow + btnsCur;
End
Else
Begin
btnsNew := btnsNow;
End;
End
Else
Begin
If (navBtn in btnsNow) Then
Begin
btnsNew := btnsNow - btnsCur;
End
Else
Begin
btnsNew := btnsNow;
End;
End;
nav.VisibleButtons := btnsNew;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
procedure TDBMemo_ads.SetTitleOfWindow(const Value: String);
begin
ProcName := 'TDBMemo_ads.SetTitleOfWindow'; Try
FTitleOfWindow := Value;
If IsObject(Self,TForm) Then
Begin
TForm(Self).Caption := Value;
End
Else
Begin
If Self.Owner <> nil Then
Begin
If IsObject(Owner,TForm) Then
TForm(Owner).Caption := Value;
End;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.SetStayOnTop(const Value: Boolean);
begin
ProcName := 'TDBMemo_ads.SetStayOnTop'; Try
FStayOnTop := Value;
If IsObject(Self,TForm) Then
Begin
If Value Then
Begin
TForm(Self).FormStyle := fsStayOnTop;
End
Else
Begin
TForm(Self).FormStyle := fsNormal;
End;
End
Else
Begin
If Value Then
Begin
TForm(Owner).FormStyle := fsStayOnTop;
End
Else
Begin
TForm(Owner).FormStyle := fsNormal;
End;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
Function TDBMemo_ads.IsObject(Obj : TObject; Cls : TClass): Boolean;
Begin
Result := False;
ProcName := 'TDBMemo_ads.IsObject'; Try
Result := (Obj is Cls);
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;
procedure TDBMemo_ads.SetFileName(const Value: String);
begin
ProcName := 'TDBMemo_ads.SetFileName'; Try
FFileName := Value;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.SaveToFile;
begin
ProcName := 'TDBMemo_ads.SaveToFile'; Try
If FileName <> '' Then
Begin
DBMemo.Lines.SaveToFile(FileName);
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.SetDataLabel(const Value: String);
Var
sgTemp : String;
begin
ProcName := 'TDBMemo_ads.SetDataLabel'; Try
FDataLabel := Value;
sgTemp := Trim(Value);
If sgTemp = '' Then
Begin
pnlTitle.Height := 0;
pnlTitle.Caption := '';
End
Else
Begin
pnlTitle.Height := 20;
pnlTitle.Caption := Value;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.pnlBaseMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
ProcName := 'TDBMemo_ads.pnlBaseMouseDown'; Try
If DragMovable Or DragReSizable Then
Begin
If ssLeft in Shift Then
Begin
FDragResizing := (ssCtrl in Shift) And DragReSizable;
FDragStartX := X;
FDragStartY := Y;
FDragging := DragMovable Or FDragResizing;
FCursorWas := Screen.Cursor;
If (Y < 7) Or (Y > (TControl(Self).Height-10)) Then
Begin
If (Not FDragResizing) And FDragging Then
Begin
Screen.Cursor := crVSplit;
End
Else
Begin
If FDragResizing Then Screen.Cursor := crSizeNS;
End;
End
Else
Begin
If (Not FDragResizing) And FDragging Then
Begin
Screen.Cursor := crHSplit;
End
Else
Begin
If FDragResizing Then Screen.Cursor := crSizeWE;
End;
End;
End;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.pnlBaseMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
Var
inChange : Integer;
Control : TWinControl;
begin
ProcName := 'TDBMemo_ads.pnlBaseMouseUp'; Try
Control := nil;
If IsObject(Self,TForm) Then
Begin
Control := TWinControl(Self);
End
Else
Begin
If IsObject(Self,TScrollingWinControl) Then
Begin
Control := TWinControl(Self).Parent;
End;
End;
If DragMovable Or DragReSizable Then
Begin
If FDragging Then
Begin
If FDragResizing Then
Begin
If Screen.Cursor = crSizeWE Then
Begin
inChange := X-FDragStartX;
If FDragStartX < 10 Then
Begin
Control.Left := Control.Left+inChange;
Control.Width := Control.Width-inChange;
End
Else
Begin
Control.Left := Control.Left;
Control.Width := Control.Width+inChange;
End;
End
Else
Begin
inChange := Y-FDragStartY;
If FDragStartY < 10 Then
Begin
Control.Top := Control.Top+inChange;
Control.Height := Control.Height-inChange;
End
Else
Begin
Control.Top := Control.Top;
Control.Height := Control.Height+inChange;
End;
End;
Screen.Cursor := FCursorWas;
End
Else
Begin
Control.Top := Control.Top +(Y-FDragStartY);
Control.Left := Control.Left+(X-FDragStartX);
Screen.Cursor := FCursorWas;
End;
End;
End;
FDragging := False;
FDragResizing := False;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.SetDragMovable(const Value: Boolean);
begin
ProcName := 'TDBMemo_ads.SetDragMovable'; Try
FDragMovable := Value;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.SetDragResizable(const Value: Boolean);
begin
ProcName := 'TDBMemo_ads.SetDragResizable'; Try
FDragResizable := Value;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.SetBorder(const Value: Boolean);
begin
ProcName := 'TDBMemo_ads.SetBorder'; Try
FBorder := Value;
If Value Then
Begin
pnlBase.BorderStyle := bsSingle;
End
Else
Begin
pnlBase.BorderStyle := bsNone;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.SetParentControl(Value: TWinControl);
begin
ProcName := 'TDBMemo_ads.SetParentControl'; Try
If Modal Then Value := nil;
FParentControl := Value;
If TWinControl(Self).Parent <> Value Then TWinControl(Self).Parent := Value;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.NavigatorShowExecute(Sender: TObject);
begin
ProcName := 'TDBMemo_ads.NavigatorShowExecute'; Try
ShowNavigator := Not ShowNavigator;
If ShowNavigator Then
Begin
TAction(Sender).Caption := 'Hide Navigator';
TAction(Sender).Hint := 'Hide the record navigator.';
End
Else
Begin
TAction(Sender).Caption := 'Show Navigator';
TAction(Sender).Hint := 'Show the record navigator.';
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.ActionNavShowCancelExecute(Sender: TObject);
Var
sgTemp : String;
begin
ProcName := 'TDBMemo_ads.ActionNavShowCancelExecute'; Try
sgTemp := 'Cancel';
ShowNavCancel := Not ShowNavCancel;
If ShowNavCancel Then
Begin
TAction(Sender).Caption := 'Hide '+sgTemp;
TAction(Sender).Hint := 'Hide the navigator '+sgTemp+' button';
End
Else
Begin
TAction(Sender).Caption := 'Show '+sgTemp;
TAction(Sender).Hint := 'Show the navigator '+sgTemp+' button';
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.ActionNavShowDeleteExecute(Sender: TObject);
Var
sgTemp : String;
begin
ProcName := 'TDBMemo_ads.ActionNavShowDeleteExecute'; Try
sgTemp := 'Delete';
ShowNavDelete := Not ShowNavDelete;
If ShowNavDelete Then
Begin
TAction(Sender).Caption := 'Hide '+sgTemp;
TAction(Sender).Hint := 'Hide the navigator '+sgTemp+' button';
End
Else
Begin
TAction(Sender).Caption := 'Show '+sgTemp;
TAction(Sender).Hint := 'Show the navigator '+sgTemp+' button';
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.ActionNavShowEditExecute(Sender: TObject);
Var
sgTemp : String;
begin
ProcName := 'TDBMemo_ads.ActionNavShowEditExecute'; Try
sgTemp := 'Edit';
ShowNavEdit := Not ShowNavEdit;
If ShowNavEdit Then
Begin
TAction(Sender).Caption := 'Hide '+sgTemp;
TAction(Sender).Hint := 'Hide the navigator '+sgTemp+' button';
End
Else
Begin
TAction(Sender).Caption := 'Show '+sgTemp;
TAction(Sender).Hint := 'Show the navigator '+sgTemp+' button';
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.ActionNavShowPostExecute(Sender: TObject);
Var
sgTemp : String;
begin
ProcName := 'TDBMemo_ads.ActionNavShowPostExecute'; Try
sgTemp := 'Post';
ShowNavPost := Not ShowNavPost;
If ShowNavPost Then
Begin
TAction(Sender).Caption := 'Hide '+sgTemp;
TAction(Sender).Hint := 'Hide the navigator '+sgTemp+' button';
End
Else
Begin
TAction(Sender).Caption := 'Show '+sgTemp;
TAction(Sender).Hint := 'Show the navigator '+sgTemp+' button';
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.ActionNavShowRefreshExecute(Sender: TObject);
Var
sgTemp : String;
begin
ProcName := 'TDBMemo_ads.ActionNavShowRefreshExecute'; Try
sgTemp := 'Refresh';
ShowNavRefresh := Not ShowNavRefresh;
If ShowNavRefresh Then
Begin
TAction(Sender).Caption := 'Hide '+sgTemp;
TAction(Sender).Hint := 'Hide the navigator '+sgTemp+' button';
End
Else
Begin
TAction(Sender).Caption := 'Show '+sgTemp;
TAction(Sender).Hint := 'Show the navigator '+sgTemp+' button';
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.ActionNavShowInsertExecute(Sender: TObject);
Var
sgTemp : String;
begin
ProcName := 'TDBMemo_ads.ActionNavShowInsertExecute'; Try
sgTemp := 'Insert';
ShowNavInsert := Not ShowNavInsert;
If ShowNavInsert Then
Begin
TAction(Sender).Caption := 'Hide '+sgTemp;
TAction(Sender).Hint := 'Hide the navigator '+sgTemp+' button';
End
Else
Begin
TAction(Sender).Caption := 'Show '+sgTemp;
TAction(Sender).Hint := 'Show the navigator '+sgTemp+' button';
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.ActionNavShowFirstExecute(Sender: TObject);
Var
sgTemp : String;
begin
ProcName := 'TDBMemo_ads.ActionNavShowFirstExecute'; Try
sgTemp := 'First';
ShowNavFirst := Not ShowNavFirst;
If ShowNavFirst Then
Begin
TAction(Sender).Caption := 'Hide '+sgTemp;
TAction(Sender).Hint := 'Hide the navigator '+sgTemp+' button';
End
Else
Begin
TAction(Sender).Caption := 'Show '+sgTemp;
TAction(Sender).Hint := 'Show the navigator '+sgTemp+' button';
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.ActionNavShowPriorExecute(Sender: TObject);
Var
sgTemp : String;
begin
ProcName := 'TDBMemo_ads.ActionNavShowPriorExecute'; Try
sgTemp := 'Prior';
ShowNavPrior := Not ShowNavPrior;
If ShowNavPrior Then
Begin
TAction(Sender).Caption := 'Hide '+sgTemp;
TAction(Sender).Hint := 'Hide the navigator '+sgTemp+' button';
End
Else
Begin
TAction(Sender).Caption := 'Show '+sgTemp;
TAction(Sender).Hint := 'Show the navigator '+sgTemp+' button';
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.ActionNavShowNextExecute(Sender: TObject);
Var
sgTemp : String;
begin
ProcName := 'TDBMemo_ads.ActionNavShowNextExecute'; Try
sgTemp := 'Next';
ShowNavNext := Not ShowNavNext;
If ShowNavNext Then
Begin
TAction(Sender).Caption := 'Hide '+sgTemp;
TAction(Sender).Hint := 'Hide the navigator '+sgTemp+' button';
End
Else
Begin
TAction(Sender).Caption := 'Show '+sgTemp;
TAction(Sender).Hint := 'Show the navigator '+sgTemp+' button';
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.ActionNavShowLastExecute(Sender: TObject);
Var
sgTemp : String;
begin
ProcName := 'TDBMemo_ads.ActionNavShowLastExecute'; Try
sgTemp := 'Last';
ShowNavLast := Not ShowNavLast;
If ShowNavLast Then
Begin
TAction(Sender).Caption := 'Hide '+sgTemp;
TAction(Sender).Hint := 'Hide the navigator '+sgTemp+' button';
End
Else
Begin
TAction(Sender).Caption := 'Show '+sgTemp;
TAction(Sender).Hint := 'Show the navigator '+sgTemp+' button';
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.ActionMemoWordWrapExecute(Sender: TObject);
Var
sgTemp : String;
begin
ProcName := 'TDBMemo_ads.ActionMemoWordWrapExecute'; Try
sgTemp := 'Wordwrap';
WordWrap := Not WordWrap;
If WordWrap Then
Begin
TAction(Sender).Caption := 'Turn '+sgTemp+' Off';
TAction(Sender).Hint := 'Turn '+sgTemp+' Off';
End
Else
Begin
TAction(Sender).Caption := 'Turn '+sgTemp+' On';
TAction(Sender).Hint := 'Turn '+sgTemp+' On';
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.ActionMemoPlainTextExecute(Sender: TObject);
Var
sgTemp : String;
begin
ProcName := 'TDBMemo_ads.ActionMemoPlainTextExecute'; Try
sgTemp := 'PlainText';
PlainText := Not PlainText;
If PlainText Then
Begin
TAction(Sender).Caption := 'Turn '+sgTemp+' Off';
TAction(Sender).Hint := 'Turn '+sgTemp+' Off';
End
Else
Begin
TAction(Sender).Caption := 'Turn '+sgTemp+' On';
TAction(Sender).Hint := 'Turn '+sgTemp+' On';
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.DBMemoMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
Var
ControlXY : TPoint;
ScreenXY : TPoint;
begin
ProcName := 'TDBMemo_ads.DBMemoMouseDown'; Try
If ssRight in Shift Then
Begin
ControlXY.x := X;
ControlXY.y := Y;
ScreenXY := DBMemo.ClientToScreen(ControlXY);
If PopupEnabled Then mnu.Popup(ScreenXY.X,ScreenXY.Y);
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.ActionMemoReadOnlyExecute(Sender: TObject);
Var
sgTemp : String;
begin
ProcName := 'TDBMemo_ads.ActionMemoReadOnlyExecute'; Try
sgTemp := 'ReadOnly';
ReadOnly := Not ReadOnly;
If ReadOnly Then
Begin
TAction(Sender).Caption := 'Turn '+sgTemp+' Off';
TAction(Sender).Hint := 'Turn '+sgTemp+' Off';
End
Else
Begin
TAction(Sender).Caption := 'Turn '+sgTemp+' On';
TAction(Sender).Hint := 'Turn '+sgTemp+' On';
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.ActionAppearanceFontExecute(Sender: TObject);
begin
ProcName := 'TDBMemo_ads.ActionAppearanceFontExecute'; Try
FontDialog.Font := DBMemo.Font;
If FontDialog.Execute Then
Begin
DBMemo.Font := FontDialog.Font;
pnlTitle.Font := FontDialog.Font;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.ActionAppearanceBorderExecute(Sender: TObject);
Var
sgTemp : String;
begin
ProcName := 'TDBMemo_ads.ActionAppearanceBorderExecute'; Try
sgTemp := 'Border';
Border := Not Border;
If Border Then
Begin
TAction(Sender).Caption := 'Turn '+sgTemp+' Off';
TAction(Sender).Hint := 'Turn '+sgTemp+' Off';
End
Else
Begin
TAction(Sender).Caption := 'Turn '+sgTemp+' On';
TAction(Sender).Hint := 'Turn '+sgTemp+' On';
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.ActionAppearanceMovableExecute(Sender: TObject);
Var
sgTemp : String;
begin
ProcName := 'TDBMemo_ads.ActionAppearanceBorderExecute'; Try
sgTemp := 'Moveability';
DragMovable := Not DragMovable;
If DragMovable Then
Begin
TAction(Sender).Caption := 'Turn '+sgTemp+' Off';
TAction(Sender).Hint := 'Turn '+sgTemp+' Off';
End
Else
Begin
TAction(Sender).Caption := 'Turn '+sgTemp+' On';
TAction(Sender).Hint := 'Turn '+sgTemp+' On';
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.ActionAppearanceResizeExecute(Sender: TObject);
Var
sgTemp : String;
begin
ProcName := 'TDBMemo_ads.ActionAppearanceResizeExecute'; Try
sgTemp := 'Resize';
DragResizable := Not DragResizable;
If DragResizable Then
Begin
TAction(Sender).Caption := 'Turn '+sgTemp+' Off';
TAction(Sender).Hint := 'Turn '+sgTemp+' Off';
End
Else
Begin
TAction(Sender).Caption := 'Turn '+sgTemp+' On';
TAction(Sender).Hint := 'Turn '+sgTemp+' On';
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.ActionAppearanceBringToFrontExecute(Sender: TObject);
begin
ProcName := 'TDBMemo_ads.ActionAppearanceBringToFrontExecute'; Try
TForm(Owner).BringToFront;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.ActionAppearanceSendToBackExecute(Sender: TObject);
begin
ProcName := 'TDBMemo_ads.ActionAppearanceBringToFrontExecute'; Try
TForm(Owner).SendToBack;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.SetPopupEnabled(const Value: Boolean);
begin
ProcName := 'TDBMemo_ads.SetPopupEnabled'; Try
FPopupEnabled := Value;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
function TDBMemo_ads.GetOnMemoChange: TNotifyEvent;
begin
ProcName := 'TDBMemo_ads.GetOnMemoChange'; Try
Result := DBMemo.OnChange;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
function TDBMemo_ads.GetOnMemoClick: TNotifyEvent;
begin
ProcName := 'TDBMemo_ads.GetOnMemoClick'; Try
Result := DBMemo.OnClick;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
function TDBMemo_ads.GetOnMemoDblClick: TNotifyEvent;
begin
ProcName := 'TDBMemo_ads.GetOnMemoDblClick'; Try
Result := DBMemo.OnDblClick;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
function TDBMemo_ads.GetOnMemoDragDrop: TDragDropEvent;
begin
ProcName := 'TDBMemo_ads.GetOnMemoDragDrop'; Try
Result := DBMemo.OnDragDrop;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
function TDBMemo_ads.GetOnMemoDragOver: TDragOverEvent;
begin
ProcName := 'TDBMemo_ads.GetOnMemoDragOver'; Try
Result := DBMemo.OnDragOver;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
function TDBMemo_ads.GetOnMemoEndDock: TEndDragEvent;
begin
ProcName := 'TDBMemo_ads.GetOnMemoEndDock'; Try
Result := DBMemo.OnEndDock;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
function TDBMemo_ads.GetOnMemoEndDrag: TEndDragEvent;
begin
ProcName := 'TDBMemo_ads.GetOnMemoEndDrag'; Try
Result := DBMemo.OnEndDrag;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
function TDBMemo_ads.GetOnMemoEnter: TNotifyEvent;
begin
ProcName := 'TDBMemo_ads.GetOnMemoEnter'; Try
Result := DBMemo.OnEnter;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
function TDBMemo_ads.GetOnMemoExit: TNotifyEvent;
begin
ProcName := 'TDBMemo_ads.GetOnMemoExit'; Try
Result := DBMemo.OnExit;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
function TDBMemo_ads.GetOnMemoKeyDown: TKeyEvent;
begin
ProcName := 'TDBMemo_ads.GetOnMemoKeyDown'; Try
Result := DBMemo.OnKeyDown;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
function TDBMemo_ads.GetOnMemoKeyPress: TKeyPressEvent;
begin
ProcName := 'TDBMemo_ads.GetOnMemoKeyPress'; Try
Result := DBMemo.OnKeyPress;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
function TDBMemo_ads.GetOnMemoKeyUp: TKeyEvent;
begin
ProcName := 'TDBMemo_ads.GetOnMemoKeyUp'; Try
Result := DBMemo.OnKeyUp;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
function TDBMemo_ads.GetOnMemoMouseDown: TMouseEvent;
begin
ProcName := 'TDBMemo_ads.GetOnMemoMouseDown'; Try
Result := DBMemo.OnMouseDown;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
function TDBMemo_ads.GetOnMemoMouseMove: TMouseMoveEvent;
begin
ProcName := 'TDBMemo_ads.GetOnMemoMouseMove'; Try
Result := DBMemo.OnMouseMove;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
function TDBMemo_ads.GetOnMemoMouseUp: TMouseEvent;
begin
ProcName := 'TDBMemo_ads.GetOnMemoMouseUp'; Try
Result := DBMemo.OnMouseUp;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
function TDBMemo_ads.GetOnMemoProtectChange: TRichEditProtectChange;
begin
ProcName := 'TDBMemo_ads.GetOnMemoProtectChange'; Try
Result := DBMemo.OnProtectChange;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
function TDBMemo_ads.GetOnMemoResizeRequest: TRichEditResizeEvent;
begin
ProcName := 'TDBMemo_ads.GetOnMemoResizeRequest'; Try
Result := DBMemo.OnResizeRequest;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
function TDBMemo_ads.GetOnMemoSaveClipboard: TRichEditSaveClipboard;
begin
ProcName := 'TDBMemo_ads.GetOnMemoSaveClipboard'; Try
Result := DBMemo.OnSaveClipboard;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
function TDBMemo_ads.GetOnMemoSelectionChange: TNotifyEvent;
begin
ProcName := 'TDBMemo_ads.GetOnMemoSelectionChange'; Try
Result := DBMemo.OnSelectionChange;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
function TDBMemo_ads.GetOnMemoStartDock: TStartDockEvent;
begin
ProcName := 'TDBMemo_ads.GetOnMemoStartDock'; Try
Result := DBMemo.OnStartDock;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
function TDBMemo_ads.GetOnMemoStartDrag: TStartDragEvent;
begin
ProcName := 'TDBMemo_ads.GetOnMemoStartDrag'; Try
Result := DBMemo.OnStartDrag;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.SetOnMemoChange(const Value: TNotifyEvent);
begin
ProcName := ' TDBMemo_ads.SetOnMemoChange(const Value:'; Try
DBMemo.OnChange := Value;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.SetOnMemoClick(const Value: TNotifyEvent);
begin
ProcName := ' TDBMemo_ads.SetOnMemoClick(const Value:'; Try
DBMemo.OnClick := Value;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.SetOnMemoDblClick(const Value: TNotifyEvent);
begin
ProcName := ' TDBMemo_ads.SetOnMemoDblClick(const Value:'; Try
DBMemo.OnDblClick := Value;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.SetOnMemoDragDrop(const Value: TDragDropEvent);
begin
ProcName := ' TDBMemo_ads.SetOnMemoDragDrop(const Value:'; Try
DBMemo.OnDragDrop := Value;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.SetOnMemoDragOver(const Value: TDragOverEvent);
begin
ProcName := ' TDBMemo_ads.SetOnMemoDragOver(const Value:'; Try
DBMemo.OnDragOver := Value;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.SetOnMemoEndDock(const Value: TEndDragEvent);
begin
ProcName := ' TDBMemo_ads.SetOnMemoEndDock(const Value:'; Try
DBMemo.OnEndDock := Value;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.SetOnMemoEndDrag(const Value: TEndDragEvent);
begin
ProcName := ' TDBMemo_ads.SetOnMemoEndDrag(const Value:'; Try
DBMemo.OnEndDrag := Value;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.SetOnMemoEnter(const Value: TNotifyEvent);
begin
ProcName := ' TDBMemo_ads.SetOnMemoEnter(const Value:'; Try
DBMemo.OnEnter := Value;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.SetOnMemoExit(const Value: TNotifyEvent);
begin
ProcName := ' TDBMemo_ads.SetOnMemoExit(const Value:'; Try
DBMemo.OnExit := Value;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.SetOnMemoKeyDown(const Value: TKeyEvent);
begin
ProcName := ' TDBMemo_ads.SetOnMemoKeyDown(const Value:'; Try
DBMemo.OnKeyDown := Value;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.SetOnMemoKeyPress(const Value: TKeyPressEvent);
begin
ProcName := ' TDBMemo_ads.SetOnMemoKeyPress(const Value:'; Try
DBMemo.OnKeyPress := Value;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.SetOnMemoKeyUp(const Value: TKeyEvent);
begin
ProcName := ' TDBMemo_ads.SetOnMemoKeyUp(const Value:'; Try
DBMemo.OnKeyUp := Value;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.SetOnMemoMouseDown(const Value: TMouseEvent);
begin
ProcName := ' TDBMemo_ads.SetOnMemoMouseDown(const Value:'; Try
DBMemo.OnMouseDown := Value;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.SetOnMemoMouseMove(const Value: TMouseMoveEvent);
begin
ProcName := ' TDBMemo_ads.SetOnMemoMouseMove(const Value:'; Try
DBMemo.OnMouseMove := Value;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.SetOnMemoMouseUp(const Value: TMouseEvent);
begin
ProcName := ' TDBMemo_ads.SetOnMemoMouseUp(const Value:'; Try
DBMemo.OnMouseUp := Value;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.SetOnMemoProtectChange(const Value: TRichEditProtectChange);
begin
ProcName := ' TDBMemo_ads.SetOnMemoProtectChange(const Value:'; Try
DBMemo.OnProtectChange := Value;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.SetOnMemoResizeRequest(const Value: TRichEditResizeEvent);
begin
ProcName := ' TDBMemo_ads.SetOnMemoResizeRequest(const Value:'; Try
DBMemo.OnResizeRequest := Value;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.SetOnMemoSaveClipboard(const Value: TRichEditSaveClipboard);
begin
ProcName := ' TDBMemo_ads.SetOnMemoSaveClipboard(const Value:'; Try
DBMemo.OnSaveClipboard := Value;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.SetOnMemoSelectionChange(const Value: TNotifyEvent);
begin
ProcName := ' TDBMemo_ads.SetOnMemoSelectionChange(const Value:'; Try
DBMemo.OnSelectionChange := Value;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.SetOnMemoStartDock(const Value: TStartDockEvent);
begin
ProcName := ' TDBMemo_ads.SetOnMemoStartDock(const Value:'; Try
DBMemo.OnStartDock := Value;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.SetOnMemoStartDrag(const Value: TStartDragEvent);
begin
ProcName := ' TDBMemo_ads.SetOnMemoStartDrag(const Value:'; Try
DBMemo.OnStartDrag := Value;
Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;
procedure TDBMemo_ads.btnOKClick(Sender: TObject);
begin
//If DBMemo.Modified Then
//Begin
If
Not
(
(DBMemo.DataSource.DataSet.State = dsEdit)
Or
(DBMemo.DataSource.DataSet.State = dsInsert)
)
Then
Begin
Try DBMemo.DataSource.DataSet.Edit; Except End;
End;
DBMemo.DataSource.DataSet.Post;
//End;
end;
procedure TDBMemo_ads.btnCancelClick(Sender: TObject);
begin
//If DBMemo.Modified Then
//Begin
If
Not
(
(DBMemo.DataSource.DataSet.State = dsEdit)
Or
(DBMemo.DataSource.DataSet.State = dsInsert)
)
Then
Begin
Try DBMemo.DataSource.DataSet.Edit; Except End;
End;
DBMemo.DataSource.DataSet.Cancel;
//End;
end;