rm_edit.pas

进销存·完整的·有数据库的·非常完整·只得参考

{*****************************************}
{                                         }
{            Report Machine v2.0          }
{               Memo editor               }
{                                         }
{*****************************************}

unit RM_edit;

interface

{$I RM.inc}

uses
  SysUtils,  Windows,  Messages,  Classes,  Graphics,  Controls,  Forms,
  StdCtrls,  Buttons,  RM_Class,  RM_Insp,  ExtCtrls,  ComCtrls
{$IFDEF MWEDIT}
  ,  mwHighlighter,  mwPasSyn,  mwCustomEdit
{$ENDIF};

type
  TRMEditorForm = class(TRMObjEditorForm)
    ScriptPanel: TPanel;
    MemoPanel: TPanel;
    M1: TMemo;
    Panel3: TPanel;
    Bevel1: TBevel;
    Panel1: TPanel;
    btnInsExpr: TSpeedButton;
    btnInsDBField: TSpeedButton;
    BtnWordWrap: TSpeedButton;
    Bevel2: TBevel;
    ErrorPanel: TPanel;
    btnOK: TSpeedButton;
    btnCancel: TSpeedButton;
    btnCut: TSpeedButton;
    btnCopy: TSpeedButton;
    btnPaste: TSpeedButton;
    Splitter: TSplitter;
    St_bar: TStatusBar;
    procedure M1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure btnInsDBFieldClick(Sender: TObject);
    procedure M1Enter(Sender: TObject);
    procedure BtnWordWrapClick(Sender: TObject);
    procedure btnInsExprClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure btnOKClick(Sender: TObject);
    procedure btnCancelClick(Sender: TObject);
    procedure btnCutClick(Sender: TObject);
    procedure btnCopyClick(Sender: TObject);
    procedure btnPasteClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure M1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure M1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
    FSplitterPos: Integer;
{$IFDEF MWEDIT}
    M2: TmwCustomEdit;
{$ELSE}
    M2: TMemo;
{$ENDIF}
    FActiveMemo: TWinControl;
    FView: TRMView;
    FRowStr, FColStr: string;
    procedure SetSelText(s: string);
    procedure Localize;
    procedure ShowStatusbar(Sender: TObject);
  public
    { Public declarations }
    function ShowEditor(View: TRMView): TModalResult; override;
    function ShowScriptEditor(StringList: TStringList): TModalResult;
  end;

implementation

{$R *.DFM}

uses Registry,
  RM_Const1,
  RM_Const,
  RM_Utils;

procedure TRMEditorForm.Localize;
begin
  Font.Name := RMLoadStr(SRMDefaultFontName);
  Font.Size := StrToInt(RMLoadStr(SRMDefaultFontSize));
  Font.Charset := StrToInt(RMLoadStr(SCharset));

  RMSetStrProp(Self, 'Caption', rmRes + 060);
  RMSetStrProp(btnInsExpr, 'Hint', rmRes + 061);
  RMSetStrProp(btnInsDBField, 'Hint', rmRes + 062);
  RMSetStrProp(btnCut, 'Hint', rmRes + 091);
  RMSetStrProp(btnCopy, 'Hint', rmRes + 092);
  RMSetStrProp(btnPaste, 'Hint', rmRes + 093);
  RMSetStrProp(BtnWordWrap, 'Hint', rmRes + 063);
  RMSetStrProp(btnInsExpr, 'Caption', rmRes + 701);
  RMSetStrProp(btnInsDBField, 'Caption', rmRes + 65);

  FRowStr := RMLoadStr(rmRes + 578);
  FColStr := RMLoadStr(rmRes + 579);

  btnOK.Caption := RMLoadStr(SOk);
  btnCancel.Caption := RMLoadStr(SCancel);
end;

procedure TRMEditorForm.SetSelText(s: string);
begin
  if FActiveMemo = M1 then
    M1.SelText := s
  else
    M2.SelText := s;
end;

function TRMEditorForm.ShowEditor(View: TRMView): TModalResult;
var
  EmptyScript: Boolean;
  ScriptText: string;
  Ini: TRegIniFile;
  Nm: string;
begin
  Ini := TRegIniFile.Create(RegRootKey);
  try
    Nm := rsForm + RMDesigner.ClassName;
    FView := View;

    MemoPanel.Show;
    Splitter.Visible := True;
    Splitter.Align := alNone;
    ScriptPanel.Show;
    ScriptPanel.Align := alBottom;
    ScriptPanel.Height := ClientHeight - FSplitterPos - 2;
    Splitter.Align := alBottom;
    MemoPanel.Align := alClient;

    ErrorPanel.Hide;
    BtnWordWrap.Click;
    M1.Lines.Assign(FView.Memo);
    M2.Lines.Assign(FView.Script);
    if FView.Script.Text = '' then
      M2.Text := 'begin' + #13#10 + '  ' + #13#10 + 'end';

    M1.Font.Name := Ini.ReadString(Nm, 'TextFontName', 'Arial');
    M1.Font.Size := Ini.ReadInteger(Nm, 'TextFontSize', 10);
    M2.Font.Name := Ini.ReadString(Nm, 'ScriptFontName', 'Courier New');
    M2.Font.Size := Ini.ReadInteger(Nm, 'ScriptFontSize', 10);

    if (FView is TRMMemoView) and Ini.ReadBool(Nm, 'UseDefaultFont', True) then
    begin
      M1.Font.Name := TRMMemoView(FView).Font.Name;
      M1.Font.Size := 10;
    end;
{$IFNDEF Delphi2}
    if View is TRMMemoView then
      M1.Font.Charset := TRMMemoView(View).Font.Charset
    else
      M1.Font.Charset := RMCharset;
{$IFNDEF MWEDIT}
    M2.Font.Charset := RMCharset;
{$ENDIF}
{$ENDIF}
    M1.ReadOnly := (FView.Restrictions and rmrfDontEditMemo) <> 0;
    M2.ReadOnly := (FView.Restrictions and rmrfDontEditScript) <> 0;

    FActiveMemo := M1;

    M1.Perform(EM_SETSEL, 0, 0);
    M1.Perform(EM_SCROLLCARET, 0, 0);
    Result := ShowModal;
    if Result = mrOk then
    begin
      RMDesigner.BeforeChange;
      M1.WordWrap := False;
      FView.Memo.Text := M1.Lines.Text;
      EmptyScript := (M2.Lines.Count = 3) and (Trim(M2.Lines[0]) = 'begin') and
        (Trim(M2.Lines[1]) = '') and (Trim(M2.Lines[2]) = 'end');
      if EmptyScript then
        ScriptText := ''
      else
        ScriptText := M2.Text;
      if not EmptyScript or (FView.Script.Text <> '') then
        FView.Script.Text := ScriptText;
    end;
  finally
    Ini.Free;
  end;
end;

function TRMEditorForm.ShowScriptEditor(StringList: TStringList): TModalResult;
var
  EmptyScript: Boolean;
  ScriptText: string;
  Ini: TRegIniFile;
  Nm: string;
begin
  FSplitterPos := Splitter.Top;
  Ini := TRegIniFile.Create(RegRootKey);
  try
    Nm := rsForm + RMDesigner.ClassName;

    Splitter.Visible := FALSE;
    ErrorPanel.Hide;
    btnWordWrapClick(nil);
    M2.Lines.Assign(StringList);
    if StringList.Text = '' then
      M2.Text := 'begin' + #13#10 + '  ' + #13#10 + 'end';

    M2.Font.Name := Ini.ReadString(Nm, 'ScriptFontName', 'Courier New');
    M2.Font.Size := Ini.ReadInteger(Nm, 'ScriptFontSize', 10);
{$IFNDEF Delphi2}
{$IFNDEF MWEDIT}
    M2.Font.Charset := RMCharset;
{$ENDIF}
{$ENDIF}

    MemoPanel.Hide;
    ScriptPanel.Align := alClient;
    ScriptPanel.Show;
    FActiveMemo := M2;
    if (M2.Lines.Count > 0) and (AnsiCompareText('begin', Trim(M2.Lines[0])) = 0)
      then
{$IFDEF MWEDIT}
      M2.SetSelStart(Length(M2.Lines[0]) + 5);
      M2.SetSelEnd(Length(M2.Lines[0]) + 5);
      M2.TopLine := 0;
      M2.LeftChar := 0;
{$ELSE}
      M2.SelStart := Length(M2.Lines[0]) + 2;
{$ENDIF}

    Result := ShowModal;
    if Result = mrOk then
    begin
      RMDesigner.BeforeChange;
      EmptyScript := (M2.Lines.Count = 3) and
        (Trim(M2.Lines[0]) = 'begin') and
        (Trim(M2.Lines[1]) = '') and
        (Trim(M2.Lines[2]) = 'end');
      if EmptyScript then
        ScriptText := ''
      else
        ScriptText := M2.Text;
      if not EmptyScript or (StringList.Text <> '') then
        StringList.Text := ScriptText;
    end;
  finally
    Ini.Free;
  end;
end;

const
  VK_A = 65;
  VK_X = 88;
  VK_Y = 89;
  VK_W = 87;
  VK_Q = 81;

procedure TRMEditorForm.M1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  ErrorPanel.Hide;
  if (Key = vk_Insert) and (Shift = []) then
    btnInsDBFieldClick(Self)
  else if (Key = VK_A) and (Shift = [ssCtrl]) then
  begin
    if FActiveMemo = M1 then
      M1.SelectAll
    else
      M2.SelectAll;
  end
  else if (Key = vk_X) and (Shift = [ssCtrl]) then
  begin
    if FActiveMemo = M1 then
      M1.CutToClipboard
    else
      M2.CutToClipboard;
  end
  else if (Shift = [ssCtrl]) and ((Key = VK_W) or (Key = VK_RETURN)) then
    btnOk.Click
  else if (Key = vk_Escape) or ((Key = VK_Q) and (Shift = [ssCtrl])) then
    btnCancel.Click;
end;

procedure TRMEditorForm.btnInsDBFieldClick(Sender: TObject);
var
  s: string;
begin
  s := RMDesigner.InsertDBField;
  if s <> '' then
    SetSelText(s);
  FActiveMemo.SetFocus;
end;

procedure TRMEditorForm.M1Enter(Sender: TObject);
begin
  FActiveMemo := Sender as TWinControl;
end;

procedure TRMEditorForm.BtnWordWrapClick(Sender: TObject);
begin
  M1.WordWrap := BtnWordWrap.Down;
end;

procedure TRMEditorForm.btnInsExprClick(Sender: TObject);
var
  s: string;
begin
  s := RMDesigner.InsertExpression;
  if s <> '' then
    SetSelText(s);
  FActiveMemo.SetFocus;
end;

procedure TRMEditorForm.FormCreate(Sender: TObject);
var
  Ini: TRegIniFile;
  Nm: string;
{$IFDEF MWEDIT}
  SynParser: TmwPasSyn;
{$ENDIF}
begin
  FSplitterPos := Height div 2;
  Localize;
{$IFDEF MWEDIT}
  M2 := TmwCustomEdit.Create(Self);
  M2.ParentFont := False;
  SynParser := TmwPasSyn.Create(Self);
  SynParser.CommentAttri.Foreground := clGreen;
  SynParser.IdentifierAttri.Foreground := clBlue;
  SynParser.StringAttri.Foreground := clRed;
  SynParser.SymbolAttri.Foreground := clFuchsia;
  SynParser.NumberAttri.Foreground := clTeal;
  SynParser.KeyAttri.Foreground := clNavy;
{$ELSE}
  M2 := TMemo.Create(Self);
  M2.WordWrap := False;
  M2.ScrollBars := ssVertical;
{$ENDIF}
  M2.Parent := ScriptPanel;
  M2.Align := alClient;
  M2.HelpContext := 20;
  M2.Font.Name := 'Courier New';
  M2.Font.Size := 10;
  M2.OnEnter := M1Enter;
  M2.OnKeyDOwn := M1KeyDown;
  M2.WantTabs := TRUE;
  M2.OnKeyUp := M1.OnKeyUp;
  M2.OnMouseUp := M1.OnMouseUp;
{$IFDEF MWEDIT}
  M2.Highlighter := SynParser;
  M2.Gutter.LeftOffset := 0;
  M2.Gutter.Width := 0;
  M2.Gutter.DigitCount := 3;
  M2.Gutter.ShowLineNumbers := True;
{$ENDIF}

  Ini := TRegIniFile.Create(RegRootKey);
  try
    Nm := rsForm + Self.ClassName;
    btnWordWrap.Down := Ini.ReadBool(Nm, 'WordWrap', True);
  finally
    Ini.Free;
  end;
end;

procedure TRMEditorForm.FormResize(Sender: TObject);
begin
  ErrorPanel.Hide;
end;

procedure TRMEditorForm.btnOKClick(Sender: TObject);
var
  sl1, sl2: TStringList;

  procedure ErrorPosition;
  var
    s: string;
    n, n1: Integer;
  {$IFNDEF MWEDIT}
    i, n2: Integer;
  {$ENDIF}
  begin
    s := sl2.Text;
    n := 0;
    n1 := 1;
    if Pos('/', s) <> 0 then
    begin
      n := StrToInt(Copy(s, 6, Pos('/', s) - 6));
      n1 := StrToInt(Copy(s, Pos('/', s) + 1, Pos(':', s) - Pos('/', s) - 1));
    end;

{$IFDEF MWEDIT}
    M2.SetFocus;
    M2.CaretXY := Point(n1, n);
{$ELSE}
    n2 := 0;
    for i := 0 to n - 2 do
      Inc(n2, Length(M2.Lines[i]) + 2);
    Inc(n2, n1 - 1);
    M2.SetFocus;
    M2.Perform(EM_SETSEL, n2, n2);
    M2.Perform(EM_SCROLLCARET, 0, 0);
{$ENDIF}
  end;

begin
  sl1 := TStringList.Create;
  sl2 := TStringList.Create;
  RMInterpretator.PrepareScript(M2.Lines, sl1, sl2);
  if sl2.Count > 0 then
  begin
    ErrorPanel.Caption := ' ' + sl2.Text;
    ErrorPanel.Show;
    ErrorPosition;
  end
  else
    ModalResult := mrOK;
  sl1.Free;
  sl2.Free;
end;

procedure TRMEditorForm.btnCancelClick(Sender: TObject);
begin
  ModalResult := mrCancel;
end;

procedure TRMEditorForm.btnCutClick(Sender: TObject);
begin
  if FActiveMemo = M1 then
    M1.CutToClipboard
  else
    M2.CutToClipboard;
end;

procedure TRMEditorForm.btnCopyClick(Sender: TObject);
begin
  if FActiveMemo = M1 then
    M1.CopyToClipboard
  else
    M2.CopyToClipboard;
end;

procedure TRMEditorForm.btnPasteClick(Sender: TObject);
begin
  if FActiveMemo = M1 then
    M1.PasteFromClipboard
  else
    M2.PasteFromClipboard;
end;

procedure TRMEditorForm.FormShow(Sender: TObject);
begin
  if MemoPanel.Visible then
  begin
    M1.SetFocus;
    if st_bar.Panels.Count = 2 then
      st_bar.Panels.Add;
    ShowStatusbar(M1);
  end
  else
  begin
    M2.SetFocus;
    if st_bar.Panels.Count > 2 then
    begin
      st_bar.Panels.Clear;
      st_bar.Panels.Add;
      st_bar.Panels[0].Width := 100;
      st_bar.Panels.Add;
      st_bar.Panels[1].Width := 100;
    end;
    st_bar.Panels[1].Text := '';
    ShowStatusbar(M2);
  end;
end;

procedure TRMEditorForm.FormDestroy(Sender: TObject);
var
  Ini: TRegIniFile;
  Nm: string;
begin
  Ini := TRegIniFile.Create(RegRootKey);
  try
    Nm := rsForm + Self.ClassName;
    Ini.WriteBool(Nm, 'WordWrap', BtnWordWrap.Down);
  finally
    Ini.Free;
  end;
end;

procedure TRMEditorForm.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  FSplitterPos := Splitter.Top;
end;

procedure TRMEditorForm.ShowStatusbar(Sender: TObject);
var
  Hang, Lie, Num, CharsLine: longint;
begin
{$IFDEF MWEDIT}
  if Sender is TmwCustomEdit then
    Exit;
{$ENDIF}
  Num := SendMessage(TMemo(Sender).Handle, EM_LINEFROMCHAR,
    TMemo(Sender).SelStart, 0);
  CharsLine := SendMessage(TMemo(Sender).Handle, EM_LINEINDEX, Num, 0);
  Hang := Num + 1; //当前行
  Lie := (TMemo(Sender).SelStart - CharsLine) + 1; //当前列
  if not MemoPanel.Visible then
  begin
    St_bar.Panels[0].Text := FRowStr + IntToStr(Hang) + FColStr + IntToStr(Lie);
  end
  else
  begin
    if TMemo(Sender).Name = 'M1' then
      St_bar.Panels[0].Text := FRowStr + IntToStr(Hang) + FColStr + IntToStr(Lie)
    else
      St_bar.Panels[1].Text := FRowStr + IntToStr(Hang) + FColStr + IntToStr(Lie);
  end;
end;

procedure TRMEditorForm.M1KeyUp(Sender: TObject; var Key: Word; Shift:
  TShiftState);
begin
  ShowStatusbar(Sender);
end;

procedure TRMEditorForm.M1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  ShowStatusbar(Sender);
end;

end.