smemo.pas

Alpha Controls 5.40,delphi上的alpha开发源码控件包。没有密码。5.40版的最新版。

unit sMemo;
{$I sDefs.inc}
{.$DEFINE LOGGED}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, sConst, sCommonData
  {$IFDEF TNTUNICODE}, TntClasses, TntSysUtils, TntActnList, TntStdCtrls, TntControls{$ENDIF},
  sDefaults, acSBUtils{$IFDEF LOGGED}, sDebugMsgs{$ENDIF};

type
  TsMemo = class(TMemo)
{$IFNDEF NOTFORHELP}
  private
    FCommonData: TsCommonData;
    FDisabledKind: TsDisabledKind;
    FOnVScroll: TNotifyEvent;
    FOnScrollCaret: TNotifyEvent;
    FBoundLabel: TsBoundLabel;
{$IFDEF TNTUNICODE}
    FLines: TTntStrings;
    procedure SetLines(const Value: TTntStrings);
    procedure SetSelText(const Value: WideString);
    function GetText: WideString;
    procedure SetText(const Value: WideString);
    function GetHint: WideString;
    procedure SetHint(const Value: WideString);
    function IsHintStored: Boolean;
{$ENDIF}
    procedure SetDisabledKind(const Value: TsDisabledKind);
  protected
{$IFDEF TNTUNICODE}
    procedure CreateWindowHandle(const Params: TCreateParams); override;
    procedure DefineProperties(Filer: TFiler); override;
    function GetActionLinkClass: TControlActionLinkClass; override;
    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
    function GetSelStart: Integer; reintroduce; virtual;
    procedure SetSelStart(const Value: Integer); reintroduce; virtual;
    function GetSelLength: Integer; reintroduce; virtual;
    procedure SetSelLength(const Value: Integer); reintroduce; virtual;
    function GetSelText: WideString; reintroduce;
{$ENDIF}
  public
    ListSW : TacScrollWnd;
    procedure AfterConstruction; override;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Loaded; override;
    procedure WndProc (var Message: TMessage); override;
  published
{$IFDEF TNTUNICODE}
    property SelText: WideString read GetSelText write SetSelText;
    property SelStart: Integer read GetSelStart write SetSelStart;
    property SelLength: Integer read GetSelLength write SetSelLength;
    property Text: WideString read GetText write SetText;
    property Lines: TTntStrings read FLines write SetLines;
    property Hint: WideString read GetHint write SetHint stored IsHintStored;
{$ELSE}
    property Text;
{$ENDIF}
    property CharCase;
    Property OnScrollCaret : TNotifyEvent read FOnScrollCaret write FOnScrollCaret;
    Property OnVScroll : TNotifyEvent read FOnVScroll write FOnVScroll;
{$ENDIF} // NOTFORHELP
    property BoundLabel : TsBoundLabel read FBoundLabel write FBoundLabel;
    property SkinData : TsCommonData read FCommonData write FCommonData;
    property DisabledKind : TsDisabledKind read FDisabledKind write SetDisabledKind default DefDisabledKind;
  end;

implementation

uses sVCLUtils, sMessages, sGraphUtils, sAlphaGraph, sSkinProps;

{ TsMemo }

procedure TsMemo.AfterConstruction;
begin
  inherited AfterConstruction;
  FCommonData.Loaded;
end;

{$IFDEF TNTUNICODE}
procedure TsMemo.ActionChange(Sender: TObject; CheckDefaults: Boolean);
begin
  TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
  inherited;
end;

type
  TAccessTntMemoStrings = class (TTntMemoStrings);
{$ENDIF}

constructor TsMemo.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
{$IFDEF TNTUNICODE}
  FLines := TTntMemoStrings.Create;
  TAccessTntMemoStrings(FLines).FMemo := Self;
  TAccessTntMemoStrings(FLines).FMemoLines := TCustomMemo(Self).Lines;
{$ENDIF}       
  ControlStyle := ControlStyle - [csOpaque];
  FCommonData := TsCommonData.Create(Self, {$IFDEF DYNAMICCACHE} False {$ELSE} True {$ENDIF});
  FCommonData.COC := COC_TsMemo;
  if FCommonData.SkinSection = '' then FCommonData.SkinSection := s_Edit;
  FDisabledKind := DefDisabledKind;
  FBoundLabel := TsBoundLabel.Create(Self, FCommonData);
end;

{$IFDEF TNTUNICODE}
procedure TsMemo.CreateWindowHandle(const Params: TCreateParams);
begin
  TntCustomEdit_CreateWindowHandle(Self, Params);
end;

procedure TsMemo.DefineProperties(Filer: TFiler);
begin
  inherited;
  TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;
{$ENDIF}

destructor TsMemo.Destroy;
begin
  if ListSW <> nil then FreeAndNil(ListSW);
  FreeAndNil(FBoundLabel);
  if Assigned(FCommonData) then FreeAndNil(FCommonData);
{$IFDEF TNTUNICODE}
  FreeAndNil(FLines);
{$ENDIF}
  inherited Destroy;
end;

{$IFDEF TNTUNICODE}
function TsMemo.GetActionLinkClass: TControlActionLinkClass;
begin
  Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
end;

function TsMemo.GetHint: WideString;
begin
  Result := TntControl_GetHint(Self)
end;

function TsMemo.GetSelLength: Integer;
begin
  Result := TntCustomEdit_GetSelLength(Self);
end;

function TsMemo.GetSelStart: Integer;
begin
  Result := TntCustomEdit_GetSelStart(Self);
end;

function TsMemo.GetSelText: WideString;
begin
  Result := TntCustomEdit_GetSelText(Self);
end;

function TsMemo.GetText: WideString;
begin
  Result := TntControl_GetText(Self);
end;

function TsMemo.IsHintStored: Boolean;
begin
  Result := TntControl_IsHintStored(Self);
end;
{$ENDIF}

procedure TsMemo.Loaded;
begin
  inherited Loaded;
  FCommonData.Loaded;
  RefreshEditScrolls(SkinData, ListSW);
end;

procedure TsMemo.SetDisabledKind(const Value: TsDisabledKind);
begin
  if FDisabledKind <> Value then begin
    FDisabledKind := Value;
    FCommonData.Invalidate;
  end;
end;

{$IFDEF TNTUNICODE}
procedure TsMemo.SetHint(const Value: WideString);
begin
  TntControl_SetHint(Self, Value);
end;

procedure TsMemo.SetLines(const Value: TTntStrings);
begin
  FLines.Assign(Value);
end;

procedure TsMemo.SetSelLength(const Value: Integer);
begin
  TntCustomEdit_SetSelLength(Self, Value);
end;

procedure TsMemo.SetSelStart(const Value: Integer);
begin
  TntCustomEdit_SetSelStart(Self, Value);
end;

procedure TsMemo.SetSelText(const Value: WideString);
begin
  TntCustomEdit_SetSelText(Self, Value);
end;

procedure TsMemo.SetText(const Value: WideString);
begin
  TntControl_SetText(Self, Value);
end;
{$ENDIF}

procedure TsMemo.WndProc(var Message: TMessage);
var
  PS : TPaintStruct;
begin
{$IFDEF LOGGED}
  AddToLog(Message);
{$ENDIF}
  if Message.Msg = SM_ALPHACMD then case Message.WParamHi of
    AC_CTRLHANDLED : begin Message.LParam := 1; Exit end; // AlphaSkins supported
    AC_GETAPPLICATION : begin Message.Result := longint(Application); Exit end;
    AC_SETNEWSKIN : if (LongWord(Message.LParam) = LongWord(SkinData.SkinManager)) then begin
      CommonWndProc(Message, FCommonData);
      exit
    end;
    AC_REMOVESKIN : if LongWord(Message.LParam) = LongWord(SkinData.SkinManager) then begin
      if ListSW <> nil then FreeAndNil(ListSW);
      CommonWndProc(Message, FCommonData);
      RecreateWnd;
      exit
    end;
    AC_REFRESH : if (LongWord(Message.LParam) = LongWord(SkinData.SkinManager)) then begin
      CommonWndProc(Message, FCommonData);
      RefreshEditScrolls(SkinData, ListSW);
      Perform(WM_ERASEBKGND, 0, 0);
      Repaint;
      SendMessage(Handle, WM_NCPAINT, 0, 0);
      exit
    end
  end;
  if not ControlIsReady(Self) or not FCommonData.Skinned then inherited else begin
    case Message.Msg of
      WM_PAINT : begin
        FCommonData.Updating := FCommonData.Updating;
        if FCommonData.Updating then begin // Exit if parent is not ready yet
          BeginPaint(Handle, PS);
          EndPaint(Handle, PS);
          Exit;
        end;
        inherited;
        exit;
      end;
    end;
    CommonWndProc(Message, FCommonData);
    inherited;
    if Message.Msg = SM_ALPHACMD then case Message.WParamHi of
      AC_URGENTPAINT : begin // v4.08
        if FCommonData.UrgentPainting then PrepareCache(SkinData, Handle);
      end;
    end
    else case Message.Msg of
      CM_SHOWINGCHANGED : RefreshEditScrolls(SkinData, ListSW);
      CM_VISIBLECHANGED, CM_ENABLEDCHANGED, WM_SETFONT : begin
        FCommonData.Invalidate;
      end;
      CM_TEXTCHANGED, CM_CHANGED : if Assigned(ListSW) then UpdateScrolls(ListSW, True);
      EM_SETSEL : if Assigned(FOnScrollCaret) then FOnScrollCaret(Self);
      WM_HSCROLL, WM_VSCROLL : begin
        if (Message.Msg = WM_VSCROLL) and Assigned(FOnVScroll) then begin
          FOnVScroll(Self);
        end;
      end;
    end;
  end;
  // Aligning of the bound label
  if Assigned(BoundLabel) and Assigned(BoundLabel.FtheLabel) then case Message.Msg of
    WM_SIZE, WM_WINDOWPOSCHANGED : begin BoundLabel.AlignLabel end;
    CM_VISIBLECHANGED : begin BoundLabel.FtheLabel.Visible := Visible; BoundLabel.AlignLabel end;
    CM_ENABLEDCHANGED : begin BoundLabel.FtheLabel.Enabled := Enabled; BoundLabel.AlignLabel end;
    CM_BIDIMODECHANGED : begin BoundLabel.FtheLabel.BiDiMode := BiDiMode; BoundLabel.AlignLabel end;
  end;
end;

end.