wwriched.pas

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

  if FDataLink.Field <> nil then begin
    if isBlob then
    begin
      if FAutoDisplay or (FDataLink.Editing and FMemoLoaded) then
      begin
        { Check if the data has changed since we read it the first time }
        if (FDataSave <> '') and (FDataSave = FDataLink.Field.AsString) then Exit;
        FMemoLoaded := False;
        if visible then LoadMemo;
      end else
      begin
        FMemoLoaded := False;
        Text := Format('(%s)', [FDataLink.Field.DisplayLabel]);
      end;
    end
    else begin
      FMemoLoaded := False;
      if FFocused and FDataLink.CanModify then
        Text := FDataLink.Field.Text
      else
        Text := FDataLink.Field.DisplayText;
      FMemoLoaded := True;
    end
  end
  else begin
    if csDesigning in ComponentState then Text := Name else Text := '';
    FMemoLoaded := False;
  end;

//  if HandleAllocated then
//    RedrawWindow(Handle, nil, 0, RDW_INVALIDATE or RDW_ERASE or RDW_FRAME);
end;

procedure TwwDBRichEdit.EditingChange(Sender: TObject);
begin
  if (FDataLink.Field=Nil) then exit;
  inherited ReadOnly := not (FDataLink.Editing and FMemoLoaded);
end;

procedure TwwDBRichEdit.UpdateData(Sender: TObject);
begin
   UpdateField;
end;

procedure TwwDBRichEdit.UpdateField;
var
  Stream: TStringStream;
begin
  if (FDataLink.Field=Nil) then exit;
  if modified and FMemoLoaded then
  begin
    if IsBlob then
    begin
       if ((FDataLink.Field as TBlobField).BlobType = ftWideMemo) then
       begin
         Stream := TStringStream.Create('');
         try
            ILines.SaveToStream(Stream);
            FDataLink.Field.AsString := Stream.DataString;
         finally
           Stream.Free;
         end;
       end
       else
          FDataLink.Field.Assign(ILines)
    end
    else
      FDataLink.Field.AsString := Text;
  end
end;

procedure TwwDBRichEdit.SetFocused(Value: Boolean);
begin
  if FFocused <> Value then
  begin
    FFocused := Value;
    if FDataLink=nil then exit;
    if (FDataLink.Field=Nil) then exit;
    if not Assigned(FDataLink.Field) or not isBlob then
      FDataLink.Reset;
  end;
end;

function TwwCustomRichEdit.isTransparentEffective: boolean;
begin
   result:= Frame.Transparent and Frame.IsFrameEffective and
      not wwIsDesigning(self)
end;

procedure TwwDBRichEdit.CMEnter(var Message: TCMEnter);
var
    r: TRect;
    exStyle, origStyle: longint;
begin

  SetFocused(True);
  inherited;

  if IsTransparentEffective then begin
//     Frame.CreateTransparent:= False;
     OrigStyle:= Windows.GetWindowLong(handle, GWL_EXSTYLE);
     exStyle:= OrigStyle and not WS_EX_TRANSPARENT;
     Windows.SetWindowLong(handle, GWL_EXSTYLE, exStyle);
     SetEditRect;
     invalidate;
  end;

  if Frame.enabled then begin
     if (not IsTransparentEffective) and (not IsInGridPaint(self)) then
     begin
        if (Frame.NonFocusColor<>clNone) and (LastColor<>clNone) then
        begin
           if not (csDesigning in ComponentState) then
              Color:= LastColor;
        end;
     end;
  end;

  if Frame.enabled then begin
     if IsTransparentEffective then begin
        r:= BoundsRect;
        InvalidateRect(Parent.Handle, @r, False);
     end;
     invalidate;
  end;

  if AutoSelect then
     SelectAll;

end;

procedure TwwDBRichEdit.CMExit(var Message: TCMExit);
var
//    r: TRect;
    exStyle, origStyle: longint;
begin
  if (FDataLink<>nil) and (FDataLink.Field<>Nil) then begin
    try
      FDataLink.UpdateRecord;
    except
      SetFocus;
      raise;
    end;
  end;
  SetFocused(False);
  inherited;

  if (not IsTransparentEffective) and (not IsInGridPaint(self)) then
  begin
     if Frame.Enabled and (Frame.NonFocusColor<>clNone) then
     begin
         LastColor:= Color;
         Color:= Frame.NonFocusColor;
     end;
  end;

  if IsTransparentEffective then begin
//     Frame.CreateTransparent:= True;
     OrigStyle:= Windows.GetWindowLong(handle, GWL_EXSTYLE);
     exStyle:= OrigStyle or WS_EX_TRANSPARENT;
     Windows.SetWindowLong(handle, GWL_EXSTYLE, exStyle);
//     invalidate;
  end;

  if IsTransparentEffective then begin
//  if Frame.enabled then begin
     Frame.RefreshTransparentText(True);
  end;

  if Frame.enabled then invalidate;
end;

procedure TwwDBRichEdit.SetAutoDisplay(Value: Boolean);
begin
  if (FDataLink.Field=Nil) then exit;
  if FAutoDisplay <> Value then
  begin
    FAutoDisplay := Value;
    if Value then LoadMemo;
  end;
end;

procedure TwwDBRichEdit.WMLButtonDblClk(var Message: TWMLButtonDblClk);
var ReObject: TReObject;
    TmpConn: Integer;
begin
  if (FDataLink.Field<>Nil) and (not FMemoLoaded) then LoadMemo
  else begin
     if Assigned(FRichEditOLE) then begin

        FillChar(ReObject, SizeOf(TReObject), 0);
        ReObject.cbStruct:= sizeof(TReObject);

        {$WARNINGS OFF}
        if (FRichEditOle.GetObject(REO_IOB_SELECTION, ReObject, REO_GETOBJ_POLEOBJ) = S_OK) and
           (Assigned(ReObject.oleobj)) then
        {$WARNINGS ON}
        begin
           if (Reobject.dwflags and REO_INPLACEACTIVE) <>0 then ShowMessage('');

           if (not ReadOnly) and (Patch[6]=False) then
           begin
              FOleSelObject:= ReObject.OleObj;
//              if Patch[5]<>0 then FOleSelObject.Unadvise(patch[5]);
              FOleSelObject.Advise(TwwRichEditAdviseSink.create(self), TmpConn);
//              Patch[5] := TmpConn;
              inherited;
           end
           else if not ReadOnly then inherited
           { 1/9/99, 2/22/99 - Else Don't allow OLE object to open if readonly }

           // 7/3/02 - Allow a doubleclick on oleobjects to propogate to
           // OnDblClick event
           else if ReadOnly then begin
              DblClick // Not calling inherited so fire event
           end
        end
        else inherited;
     end
     else inherited;
  end;
end;

// 10/05/00 - Added missing updateaction and executeaction methods. {PYW}
{$ifdef wwdelphi4up}
function TwwDBRichEdit.UpdateAction(Action: TBasicAction): Boolean;
begin
  Result := inherited UpdateAction(Action) or (FDataLink <> nil) and
    FDataLink.UpdateAction(Action);
end;

function TwwDBRichEdit.ExecuteAction(Action: TBasicAction): Boolean;
begin
  Result := inherited ExecuteAction(Action) or (FDataLink <> nil) and
    FDataLink.ExecuteAction(Action);
end;
{$endif}

procedure TwwDBRichEdit.WMCut(var Message: TMessage);
begin
  if (FDataLink.Field<>Nil) then BeginEditing;
  inherited;
end;

// 6/26/03
var
  cfRTFInUTF8: UINT;
  cfRTFNoNCRs: UINT;
  CF_vmRTF: UINT;

procedure TwwDBRichEdit.WMPaste(var Message: TMessage);
begin
  if (FDataLink.Field<>Nil) then BeginEditing;

  // 6/26/03 - Allow these formats (Thanks to Steve Moss for this implementation)
  if Clipboard.HasFormat(cfRTFNoNCRs) or
     Clipboard.HasFormat(cfRTFInUTF8) then
      // It seems that RichEdit 3.0 (and other versions?) controls
      // cannot successfully paste UTF8 or 'RTF with NCRs for
      // nonASCII' formats, and it defaults to pasting the latter.
      // This means that if the clipboard currently has the 'RTF
      // with NCRs for nonASCII' format, nothing is pasted. So,
      // we check here for these two problematic formats and,
      // if found, we paste the standard RTF format instead.
    SendMessage(Handle,EM_PASTESPECIAL,CF_vmRTF,0)
  else
    inherited;
end;

procedure TwwDBRichEdit.CMGetDataLink(var Message: TMessage);
begin
  if (FDataLink<>nil) and (FDataLink.Field=Nil) then exit; // 9/25/06 - Check for nil datalink
  Message.Result := Integer(FDataLink);
end;

{ 4/22/98 }
{ 2/15/99 - Don't use richedit's charset as this prevent's symbol fonts from working}
{$ifndef wwDelphi3UpXXX}
function EnumFontProc(var LogFont: TLogFont; var TextMetric: TTextMetric;
         FontType: Integer; Data: Pointer): Integer; stdcall;
begin
  PWord(Data)^ := LogFont.lfCharSet;
  Result := 0;
end;

function TwwCustomRichEdit.GetCharSetOfFontName(const FaceName : string) : integer;
var
  Flag: Word;
  DC: HDC;
begin
//  result := -1;
  result:= Font.charset; {2/15/99 }
  if Patch[4]=True then exit;

  Flag := $8000;
  DC := GetDC(0);
  EnumFontFamilies(DC, PChar(FaceName), @EnumFontProc, LPARAM(@Flag));
  ReleaseDC(0, DC);
  if Flag <> $8000 then
    Result := LoByte(Flag);
end;
{$else}
function TwwCustomRichEdit.GetCharSetOfFontName(const FaceName : string) : integer;
begin
   result:= Font.charset;
end;
{$endif}


constructor TwwCustomRichEdit.Create(AOwner: TComponent);
var DC: HDC;
begin
   inherited Create(AOwner);

   LastColor:= clNone;
   EditWidth:= rewWindowSize;
   FPrintMargins:=  TwwPrintMargins.create(self);
   FHeader:= TwwRTFHeaderFooter.create(self);
   FFooter:= TwwRTFHeaderFooter.create(self);

   PrintPageSize:= 1; { 2/6/98 - Used to be 2, not all printers support 2 }

   PopupOptions:= [rpoPopupEdit, rpoPopupCut, rpoPopupCopy, rpoPopupPaste,
         rpoPopupFind, rpoPopupReplace, rpoPopupInsertObject,
         rpoPopupBullet, rpoPopupFont, rpoPopupParagraph, rpoPopupTabs, rpoPopupMSWordSpellCheck];

   EditorOptions:=
         [reoShowSaveExit, reoShowPrint, reoShowPrintPreview, reoShowPageSetup,
            reoShowFormatBar, reoShowToolbar, reoShowStatusBar,
            reoShowHints, reoShowRuler, reoShowInsertObject, reoCloseOnEscape,
            reoFlatButtons, reoShowMainMenuIcons, reoShowSpellCheck];

   EditorCaption:= 'Edit Rich Text';
   FWordWrap:= True;
   FUnits:= muInches;

   CreateRunTimeComponents;

   DC := GetDC(0);
   ScreenPixelsPerInch := GetDeviceCaps(DC, LOGPIXELSY);
   ReleaseDC(0, DC);

   FRichEditOleCallback:= TRichEditOleCallback.Create(Self);
   FRichEditVersion:= 2;

  FEditorPosition:= TwwFormPosition.create;
  with FEditorPosition do begin
     Left:= 0;  { Auto-center }
     Top:= 0;   { Auto-center }
     Width:= 0;  { Auto-size }
     Height:= 0; { Auto-size }
  end;

  FPrintJobName:= Application.Title;

  FLines:= TwwRichEditStrings.create;
  TwwRichEditStrings(FLines).RichEdit:=self;

  FHighlightColor:= clYellow;

  FFrame:= TwwEditFrame.create(self);

end;

procedure TwwCustomRichEdit.CreateRunTimeComponents;
begin
   if (csDesigning in Componentstate) then exit;

   FindDialog1:= TFindDialog.create(self);
   with FindDialog1 do begin
     Options := [frHideUpDown, frReplace, frReplaceAll];
     OnFind := FindDialog1Find;
     {$ifdef wwDelphi3Up}
     OnClose := FindDialog1Close;
     {$endif}
   end;

   ReplaceDialog1:= TReplaceDialog.create(self);
   with ReplaceDialog1 do begin
      OnReplace:= ReplaceDialog1Replace;
      OnFind :