wwriched.pas

胜天进销存源码,国产优秀的进销存

  FAutoDisplay := True;
  FDataLink := TFieldDataLink.Create;
  FDataLink.Control := Self; // 3/20/01 - Specify control
  FDataLink.OnDataChange := DataChange;
  FDataLink.OnEditingChange := EditingChange;
  FDataLink.OnUpdateData := UpdateData;
  RichEditCopyMethod:= recmByMemory;
  OleMenuItemList:= TList.create;
  OleOptions:= [reoAdjustPopupMenu];
  GutterWidth:= 3;
  FObjectVerbs:= TStringList.create;
//  SpellCheckOptions:= [reoSpellCheck, reoGrammarCheck];

  Patch:= VarArrayCreate([0, 6], varVariant);
  Patch[0]:= False; { 8/24/98 - Used when em_findtext within WndProc }
  Patch[1]:= False; { 9/22/98 - When True use Rich Edit Version 1}
  Patch[2]:= False; { 11/4/98 - Set to True to disable Delphi 4 bug fix in CmShowingChanged }
  Patch[3]:= False; { 12/29/98 - Set to True to preserve old behavior of
                      allowing ole link to file.  The component does not support this
                      so this option is now disabled in the dialog.}
  Patch[4]:= False; { 2/15/99 - Set to True to preserve old behavior of
                      setting CharSet }
  Patch[5]:= 0; // Connection to AdviseSink
  Patch[6]:= False; { Set to True to disable new OLEAdvise behavior for checking if changed }
end;

destructor TwwDBRichEdit.Destroy;
var i: integer;
begin
  FDataLink.Free;
  FDataLink := nil;
  for i:= 0 to OleMenuItemList.count-1 do TMenuItem(OleMenuItemList[i]).Free;
  OleMenuItemList.Free;
  DestroyVerbs;
  FObjectVerbs.Free;
  FPaintControl.Free;

  inherited Destroy;
end;

procedure TwwDBRichEdit.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) then
  begin
     if (FDataLink <> nil) and (AComponent = DataSource) then DataSource := nil;
     if (AComponent = FUserSpeedButton1) then FUserSpeedButton1:= nil;
     if (AComponent = FUserSpeedButton2) then FUserSpeedButton2:= nil;
  end
end;

procedure TwwDBRichEdit.BeginEditing;
begin
  if (FDataLink.Field=Nil) then exit;
  if not FDataLink.Editing then
  try
    if isBlob then
      FDataSave := FDataLink.Field.AsString;

    if (Datasource<>nil) then begin
       if (datasource.state = dsBrowse) and (datasource.AutoEdit) then
          FDataLink.Edit;
    end;
//    FDataLink.Edit;
  finally
    FDataSave := '';
  end;

  { 4/11/00 - Moved to after datalink.editing test }
  try  { Change not fired if in grid }
    if IsInGrid(self) and (not GetReadOnly) and FDataLink.Editing then
    begin
        FDataLink.Modified;
    end;
  finally
  end

end;

type
  TCheatGridCast = class(TCustomGrid);

procedure TwwDBRichEdit.KeyDown(var Key: Word; Shift: TShiftState);
var parentGrid: TCustomGrid;
  procedure SendToParent;
  begin
    ParentGrid.setFocus;

    { If grid does not have focus then SetFocus raised exception }
    if ParentGrid.focused then  { 7/2/98 }
       TCheatGridCast(ParentGrid).KeyDown(Key, Shift);
    Key := 0;
  end;

  procedure ParentEvent;
  var
    GridKeyDown: TKeyEvent;
  begin
    { 1/25/99 - Prevent grid's OnKeyDown from firing twice when encounter tab or cr }
    if (Screen.ActiveControl<>self) and ((key=13) or (key=9)) then exit;

    GridKeyDown := TCheatGridCast(ParentGrid).OnKeyDown;
    if Assigned(GridKeyDown) then GridKeyDown(ParentGrid, Key, Shift);
  end;

  function Ctrl: Boolean;
  begin
    Result := ssCtrl in Shift;
  end;

  function Alt: Boolean;
  begin
    Result := ssAlt in Shift;
  end;


begin
  if (parent is TCustomGrid) then
  begin
     parentGrid:=  (parent as TCustomGrid);

     case Key of
       VK_ESCAPE: if not modified then SendToParent;

       // 7/2/02 - Use WantNavigationKeys property
       VK_UP, VK_DOWN, VK_NEXT, VK_PRIOR:
         begin
            if not WantNavigationKeys then
            begin
              if (not Alt) then SendToParent;
            end;
         end;
       VK_HOME: if Ctrl then SendToParent;
       VK_END: if Ctrl then SendToParent;
     end
  end;

  inherited KeyDown(Key, Shift);

  if (key=vk_f2) and (rpoPopupEdit in PopupOptions) {and not visible }then
  begin
     Execute;
     key:= 0;
  end;

  if (key=vk_insert) and (ssShift in Shift) then
     if (not CanPaste) then
     Key:= 0;
  if (key=ord('V')) and (ssCtrl in Shift) then
     if (not CanPaste) then
     Key:= 0;

  if (FDataLink.Field=Nil) then exit;
  if FMemoLoaded then
  begin
    if (Key = VK_DELETE) or (Key = VK_BACK) or
      ((Key = VK_INSERT) and (ssShift in Shift)) or
      (((Key = Ord('V')) or (Key = Ord('X'))) and (ssCtrl in Shift)) then
      BeginEditing
    else if (key=vk_return) then begin
       if WantReturns then BeginEditing
       else begin
          selStart:= 0;
          selLength:= 0;
          key:= 0;
       end
    end
  end;
end;

procedure TwwDBRichEdit.KeyPress(var Key: Char);
begin
  if (key=#9) and (not WantTabs) then begin
     key:= #0;  { Never process tabs,
                  Delphi 5 passes this to us if multi-line enabled so we need to handle it }
     exit;
  end;
  inherited KeyPress(Key);
  if (FDataLink.Field=Nil) then exit;
  if FMemoLoaded then
  begin
    if (Key in [#32..#255]) and (FDataLink.Field <> nil) and
      not FDataLink.Field.IsValidChar(Key) then
    begin
      MessageBeep(0);
      Key := #0;
    end;
    case Key of
      ^H, ^I, ^J, ^M, ^V, ^X, #32..#255:
        begin
          BeginEditing;
        end;
      #27:
        FDataLink.Reset;
    end;
  end else
  begin
    if Key = #13 then LoadMemo;
    Key := #0;
  end;
end;

procedure TwwDBRichEdit.Change;
begin
  if (csDestroying in ComponentState) then
  begin
     inherited Change;
     exit;
  end;

  if IsTransparentEffective and (not FFocused) then
  begin
     Frame.RefreshTransparentText;
     if not wwIsTransparentParent(self) then
        parent.update; { May be necessary in recordviewdialog }
  end;

  if (FDataLink.Field<>Nil) then
  begin
     if FMemoLoaded and (not SkipChange) and (not InParentChanging) then
     begin
        if (not GetReadOnly) then { 9/15/98 - Don't go into edit mode if readonly }
        begin
           BeginEditing;
           FDataLink.Modified;
        end
     end
  end;
  inherited Change;
end;

function TwwDBRichEdit.GetDataSource: TDataSource;
begin
  Result := FDataLink.DataSource;
end;

procedure TwwDBRichEdit.SetDataSource(Value: TDataSource);
begin
  FDataLink.DataSource := Value;
  if Value <> nil then Value.FreeNotification(Self);
end;

function TwwDBRichEdit.GetDataField: string;
begin
  Result := FDataLink.FieldName;
end;

procedure TwwDBRichEdit.SetDataField(const Value: string);
begin
  if (Value<>'') then begin
     if  (Value<>FDataLink.FieldName) then
        inherited ReadOnly := True;
     BoundMode:= True;
  end
  else begin
     inherited ReadOnly:= ReadOnly; // 6/10/98
     BoundMode:= False;
  end;
  FDataLink.FieldName := Value;
end;

function TwwDBRichEdit.GetReadOnly: Boolean;
begin     {1/29/98 - Add check to see if Datafield is nil to see if
                     this is an unbound case}
  if (FDataLink.Field=Nil) and (DataField = '') then
       Result:= inherited ReadOnly
  else begin
     Result := FDataLink.ReadOnly or
               ((not wwIsDesigning(self)) and
//              ((not (csDesigning in ComponentState)) and { 9/3/98 }
               (FDatalink.Field<>Nil) and
               (FDataLink.DataSet<>Nil) and
               { 9/15/98 - Check Field.ReadOnly too}
               ((not Fdatalink.Field.Dataset.CanModify) or FDataLink.Field.ReadOnly));

     // 10/18/00 - Respect Autoedit of datasource
//     if (not Result) and (Datasource<>nil) then begin
//        if (datasource.state = dsBrowse) and (not datasource.AutoEdit) then
//           Result:= True;
//     end
  end
end;

procedure TwwCustomRichEdit.BeginEditing;
begin
end;

procedure TwwCustomRichEdit.UpdateField;
begin
end;

function TwwCustomRichEdit.GetReadOnly: Boolean;
begin
   result:= inherited ReadOnly
end;

procedure TwwDBRichEdit.SetReadOnly(Value: Boolean);
begin
  if (FDataLink.Field=Nil) then inherited ReadOnly:= Value;
  {10/15/97 - Always set FDataLink.Readonly }
  if (FDataLink<>Nil) then FDataLink.ReadOnly := Value;
end;

function TwwDBRichEdit.GetField: TField;
begin
  Result := FDataLink.Field;
end;

function TwwCustomRichEdit.GetField: TField;
begin
  Result := nil;
end;

procedure TwwCustomRichEdit.LoadMemo;
begin
end;

procedure TwwDBRichEdit.LoadMemo;
var LastProtectChange:TRichEditProtectChange;
    rpc:TRichProtectClass;
    PrevCursor: TCursor;
    OldSkipChange: boolean;
    Stream: TStringStream; //10/5/06
begin
  if (FDataLink.Field=Nil) then exit;
  if not FMemoLoaded and Assigned(FDataLink.Field) and isBlob then
  begin
    OldSkipChange:= SkipChange;
    SkipChange:= True;

    PrevCursor:= Screen.Cursor;
    try try
      {1/28/97 - Allow Change of text when there is a protected flag in richtext to handle
                 TRichEdit bug.}
      LastProtectChange := OnProtectChange;
      rpc:=TRichProtectClass.Create;
      OnProtectChange:= rpc.RichProtectChange;


      { 6/8/98 - Faster than assign Lines.Assign}
      FMemoLoaded := True;  { Set to true immediately so wmpaint won't repaint repeatedly }

      // 10/5/06 Support ftWideMemo
      if (FDataLink.Field is TBlobField) and ((FDataLink.Field as TBlobField).BlobType = ftWideMemo) then
      begin
         Stream := TStringStream.create(FDataLink.Field.AsString);
         try
           Lines.LoadFromStream(Stream);
         finally
           Stream.Free;
         end;
      end
      else begin
         CopyRichEditFromBlob(FDataLink.Field);
      end;

      OnProtectChange:= LastProtectChange;
      rpc.Free;

      { 11/10/97 - If blank, then restore default setting }
      if not (csPaintCopy in ControlState) and
         (FDatalink.field.asstring='') then begin
         Paragraph.Numbering:= nsNone;
         Paragraph.alignment:= taLeftJustify;
         DefAttributes.color:= Font.Color; //clBlack;
      end;

    except
      { Rich Edit Load failure }
      on E:EOutOfResources do
        ILines.Text := Format('(%s)', [E.Message]);
    end
    finally
      Screen.Cursor:= PrevCursor;
      SkipChange:= OldSkipChange;
    end;
    EditingChange(Self);
    modified:= False; { 5/10/97}
  end;
end;

procedure TwwDBRichEdit.DataChange(Sender: TObject);
begin