unit uViewTextoRecibo; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, uViewBase, DB, uDADataTable, StdCtrls, ActnList, ComCtrls, DBCtrls, cxControls, cxContainer, cxEdit, cxTextEdit, cxMemo, cxRichEdit, cxDBRichEdit, cxDBEdit, ToolWin, ImgList, ExtCtrls, uBizRecibosCliente; { SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Buttons, ExtCtrls, Menus, ComCtrls, ClipBrd, ToolWin, ActnList, ImgList; } type IViewReciboCliente = interface ['{683E68DE-0AE8-4ADF-8D7B-BB5F4D1CBFDF}'] function GetRecibo: IBizRecibosCliente; procedure SetRecibo(const Value: IBizRecibosCliente); property Recibo: IBizRecibosCliente read GetRecibo write SetRecibo; end; TfrViewTextoRecibo = class(TfrViewBase, IViewReciboCliente) DADataSource: TDADataSource; ToolbarImages: TImageList; ActionList2: TActionList; EditUndoCmd: TAction; EditCutCmd: TAction; EditCopyCmd: TAction; EditPasteCmd: TAction; EditFontCmd: TAction; StandardToolBar: TToolBar; CutButton: TToolButton; CopyButton: TToolButton; PasteButton: TToolButton; UndoButton: TToolButton; ToolButton10: TToolButton; FontName: TComboBox; ToolButton11: TToolButton; FontSize: TEdit; UpDown1: TUpDown; ToolButton2: TToolButton; BoldButton: TToolButton; ItalicButton: TToolButton; UnderlineButton: TToolButton; ToolButton16: TToolButton; LeftAlign: TToolButton; CenterAlign: TToolButton; RightAlign: TToolButton; ToolButton20: TToolButton; BulletsButton: TToolButton; Ruler: TPanel; FirstInd: TLabel; LeftInd: TLabel; RulerLine: TBevel; RightInd: TLabel; Bevel1: TBevel; FontDialog1: TFontDialog; StatusBar: TStatusBar; Editor: TDBRichEdit; actCliente: TAction; ToolButton3: TToolButton; actImporte: TAction; actFecha: TAction; Button1: TButton; Button2: TButton; Button3: TButton; procedure SelectionChange(Sender: TObject); // procedure FormCreate(Sender: TObject); procedure CustomViewCreate(Sender: TObject); procedure ShowHint(Sender: TObject); procedure FileNew(Sender: TObject); procedure FileOpen(Sender: TObject); procedure FileSave(Sender: TObject); procedure FileSaveAs(Sender: TObject); procedure FilePrint(Sender: TObject); procedure FileExit(Sender: TObject); procedure EditUndo(Sender: TObject); procedure EditCut(Sender: TObject); procedure EditCopy(Sender: TObject); procedure EditPaste(Sender: TObject); procedure HelpAbout(Sender: TObject); procedure SelectFont(Sender: TObject); procedure RulerResize(Sender: TObject); procedure FormResize(Sender: TObject); procedure FormPaint(Sender: TObject); procedure BoldButtonClick(Sender: TObject); procedure ItalicButtonClick(Sender: TObject); procedure FontSizeChange(Sender: TObject); procedure AlignButtonClick(Sender: TObject); procedure FontNameChange(Sender: TObject); procedure UnderlineButtonClick(Sender: TObject); procedure BulletsButtonClick(Sender: TObject); procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); procedure RulerItemMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure RulerItemMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure FirstIndMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure LeftIndMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure RightIndMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); // procedure FormShow(Sender: TObject); procedure CustomViewShow(Sender: TObject); procedure RichEditChange(Sender: TObject); procedure SwitchLanguage(Sender: TObject); procedure ActionList2Update(Action: TBasicAction; var Handled: Boolean); procedure actClienteExecute(Sender: TObject); procedure actImporteExecute(Sender: TObject); procedure actFechaExecute(Sender: TObject); private // FFileName: string; FUpdating: Boolean; FDragOfs: Integer; FDragging: Boolean; function CurrText: TTextAttributes; procedure GetFontNames; procedure SetFileName(const FileName: String); procedure CheckFileSave; procedure SetupRuler; procedure SetEditRect; procedure UpdateCursorPos; procedure WMDropFiles(var Msg: TWMDropFiles); message WM_DROPFILES; procedure PerformFileOpen(const AFileName: string); procedure insertarCadena(pCadena: String); procedure SetModified(Value: Boolean); overload; procedure PrintButtonClick(Sender: TObject); protected FRecibo: IBizRecibosCliente; function GetRecibo: IBizRecibosCliente; procedure SetRecibo(const Value: IBizRecibosCliente); public property Recibo: IBizRecibosCliente read GetRecibo write SetRecibo; end; var frViewTextoRecibo: TfrViewTextoRecibo; implementation {$R *.dfm} uses RichEdit, ShellAPI; resourcestring sSaveChanges = 'Save changes to %s?'; sOverWrite = 'OK to overwrite %s'; sUntitled = 'Sin titulo'; sModified = 'Modificado'; sColRowInfo = 'Linea: %3d Columna: %3d'; const RulerAdj = 4/3; GutterWid = 6; function EnumFontsProc(var LogFont: TLogFont; var TextMetric: TTextMetric; FontType: Integer; Data: Pointer): Integer; stdcall; begin TStrings(Data).Add(LogFont.lfFaceName); Result := 1; end; procedure TfrViewTextoRecibo.ActionList2Update(Action: TBasicAction; var Handled: Boolean); begin { Update the status of the edit commands } EditCutCmd.Enabled := Editor.SelLength > 0; EditCopyCmd.Enabled := EditCutCmd.Enabled; if Editor.HandleAllocated then begin EditUndoCmd.Enabled := Editor.Perform(EM_CANUNDO, 0, 0) <> 0; EditPasteCmd.Enabled := Editor.Perform(EM_CANPASTE, 0, 0) <> 0; end; end; procedure TfrViewTextoRecibo.AlignButtonClick(Sender: TObject); begin if FUpdating then Exit; Editor.Paragraph.Alignment := TAlignment(TControl(Sender).Tag); end; procedure TfrViewTextoRecibo.BoldButtonClick(Sender: TObject); begin if FUpdating then Exit; if BoldButton.Down then CurrText.Style := CurrText.Style + [fsBold] else CurrText.Style := CurrText.Style - [fsBold]; end; procedure TfrViewTextoRecibo.BulletsButtonClick(Sender: TObject); begin if FUpdating then Exit; Editor.Paragraph.Numbering := TNumberingStyle(BulletsButton.Down); end; procedure TfrViewTextoRecibo.EditCopy(Sender: TObject); begin Editor.CopyToClipboard; end; procedure TfrViewTextoRecibo.EditCut(Sender: TObject); begin Editor.CutToClipboard; end; procedure TfrViewTextoRecibo.EditPaste(Sender: TObject); begin Editor.PasteFromClipboard; end; procedure TfrViewTextoRecibo.EditUndo(Sender: TObject); begin with Editor do if HandleAllocated then SendMessage(Handle, EM_UNDO, 0, 0); end; procedure TfrViewTextoRecibo.FileExit(Sender: TObject); begin // Close; end; procedure TfrViewTextoRecibo.FileNew(Sender: TObject); begin { SetFileName(sUntitled); Editor.Lines.Clear; Editor.Modified := False; SetModified(False); } end; procedure TfrViewTextoRecibo.FileOpen(Sender: TObject); begin { CheckFileSave; if OpenDialog.Execute then begin PerformFileOpen(OpenDialog.FileName); Editor.ReadOnly := ofReadOnly in OpenDialog.Options; end; } end; procedure TfrViewTextoRecibo.FilePrint(Sender: TObject); begin { if PrintDialog.Execute then Editor.Print(FFileName); } end; procedure TfrViewTextoRecibo.FileSave(Sender: TObject); begin { if FFileName = sUntitled then FileSaveAs(Sender) else begin Editor.Lines.SaveToFile(FFileName); Editor.Modified := False; SetModified(False); end; } end; procedure TfrViewTextoRecibo.FileSaveAs(Sender: TObject); begin { if SaveDialog.Execute then begin if FileExists(SaveDialog.FileName) then if MessageDlg(Format(sOverWrite, [SaveDialog.FileName]), mtConfirmation, mbYesNoCancel, 0) <> idYes then Exit; Editor.Lines.SaveToFile(SaveDialog.FileName); SetFileName(SaveDialog.FileName); Editor.Modified := False; SetModified(False); end; } end; procedure TfrViewTextoRecibo.FirstIndMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin FDragging := False; Editor.Paragraph.FirstIndent := Trunc((FirstInd.Left+FDragOfs-GutterWid) / RulerAdj); LeftIndMouseUp(Sender, Button, Shift, X, Y); end; procedure TfrViewTextoRecibo.FontNameChange(Sender: TObject); begin if FUpdating then Exit; CurrText.Name := FontName.Items[FontName.ItemIndex]; end; procedure TfrViewTextoRecibo.FontSizeChange(Sender: TObject); begin if FUpdating then Exit; CurrText.Size := StrToInt(FontSize.Text); end; procedure TfrViewTextoRecibo.FormCloseQuery(Sender: TObject; var CanClose: Boolean); begin { try CheckFileSave; except CanClose := False; end; } CanClose := True; end; procedure TfrViewTextoRecibo.FormPaint(Sender: TObject); begin SetEditRect; end; procedure TfrViewTextoRecibo.FormResize(Sender: TObject); begin { SetEditRect; SelectionChange(Sender); } end; procedure TfrViewTextoRecibo.HelpAbout(Sender: TObject); begin { with TAboutBox.Create(Self) do try ShowModal; finally Free; end; } end; procedure TfrViewTextoRecibo.ItalicButtonClick(Sender: TObject); begin if FUpdating then Exit; if ItalicButton.Down then CurrText.Style := CurrText.Style + [fsItalic] else CurrText.Style := CurrText.Style - [fsItalic]; end; procedure TfrViewTextoRecibo.LeftIndMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin FDragging := False; Editor.Paragraph.LeftIndent := Trunc((LeftInd.Left+FDragOfs-GutterWid) / RulerAdj)-Editor.Paragraph.FirstIndent; SelectionChange(Sender); end; procedure TfrViewTextoRecibo.PrintButtonClick(Sender: TObject); begin inherited; // end; procedure TfrViewTextoRecibo.RichEditChange(Sender: TObject); begin SetModified(Editor.Modified); end; procedure TfrViewTextoRecibo.RightIndMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin FDragging := False; Editor.Paragraph.RightIndent := Trunc((Ruler.ClientWidth-RightInd.Left+FDragOfs-2) / RulerAdj)-2*GutterWid; SelectionChange(Sender); end; procedure TfrViewTextoRecibo.RulerItemMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin FDragOfs := (TLabel(Sender).Width div 2); TLabel(Sender).Left := TLabel(Sender).Left+X-FDragOfs; FDragging := True; end; procedure TfrViewTextoRecibo.RulerItemMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin if FDragging then TLabel(Sender).Left := TLabel(Sender).Left+X-FDragOfs end; procedure TfrViewTextoRecibo.RulerResize(Sender: TObject); begin RulerLine.Width := Ruler.ClientWidth - (RulerLine.Left*2); end; procedure TfrViewTextoRecibo.SelectFont(Sender: TObject); begin FontDialog1.Font.Assign(Editor.SelAttributes); if FontDialog1.Execute then CurrText.Assign(FontDialog1.Font); SelectionChange(Self); Editor.SetFocus; end; procedure TfrViewTextoRecibo.SelectionChange(Sender: TObject); begin with Editor.Paragraph do try FUpdating := True; FirstInd.Left := Trunc(FirstIndent*RulerAdj)-4+GutterWid; LeftInd.Left := Trunc((LeftIndent+FirstIndent)*RulerAdj)-4+GutterWid; RightInd.Left := Ruler.ClientWidth-6-Trunc((RightIndent+GutterWid)*RulerAdj); BoldButton.Down := fsBold in Editor.SelAttributes.Style; ItalicButton.Down := fsItalic in Editor.SelAttributes.Style; UnderlineButton.Down := fsUnderline in Editor.SelAttributes.Style; BulletsButton.Down := Boolean(Numbering); FontSize.Text := IntToStr(Editor.SelAttributes.Size); FontName.Text := Editor.SelAttributes.Name; case Ord(Alignment) of 0: LeftAlign.Down := True; 1: RightAlign.Down := True; 2: CenterAlign.Down := True; end; UpdateCursorPos; finally FUpdating := False; end; end; procedure TfrViewTextoRecibo.ShowHint(Sender: TObject); begin if Length(Application.Hint) > 0 then begin StatusBar.SimplePanel := True; StatusBar.SimpleText := Application.Hint; end else StatusBar.SimplePanel := False; end; procedure TfrViewTextoRecibo.SwitchLanguage(Sender: TObject); //var // Name : String; // Size : Integer; begin { if LoadNewResourceModule(TComponent(Sender).Tag) <> 0 then begin Name := FontName.Text; Size := StrToInt(FontSize.Text); ReinitializeForms; LanguageEnglish.Checked := LanguageEnglish = Sender; LanguageFrench.Checked := LanguageFrench = Sender; LanguageGerman.Checked := LanguageGerman = Sender; CurrText.Name := Name; CurrText.Size := Size; SelectionChange(Self); FontName.SelLength := 0; SetupRuler; if Visible then Editor.SetFocus; end; } end; procedure TfrViewTextoRecibo.UnderlineButtonClick(Sender: TObject); begin if FUpdating then Exit; if UnderlineButton.Down then CurrText.Style := CurrText.Style + [fsUnderline] else CurrText.Style := CurrText.Style - [fsUnderline]; end; procedure TfrViewTextoRecibo.CustomViewCreate(Sender: TObject); begin inherited; Application.OnHint := ShowHint; // OpenDialog.InitialDir := ExtractFilePath(ParamStr(0)); // SaveDialog.InitialDir := OpenDialog.InitialDir; // SetFileName(sUntitled); GetFontNames; SetupRuler; SelectionChange(Self); CurrText.Name := DefFontData.Name; CurrText.Size := -MulDiv(DefFontData.Height, 72, Screen.PixelsPerInch); { LanguageEnglish.Tag := ENGLISH; LanguageFrench.Tag := FRENCH; LanguageGerman.Tag := GERMAN; case SysLocale.DefaultLCID of ENGLISH: SwitchLanguage(LanguageEnglish); FRENCH: SwitchLanguage(LanguageFrench); GERMAN: SwitchLanguage(LanguageGerman); end; } end; procedure TfrViewTextoRecibo.CustomViewShow(Sender: TObject); begin inherited; UpdateCursorPos; DragAcceptFiles(Handle, True); RichEditChange(nil); Editor.DataSource.DataSet.Edit; Editor.SetFocus; { Check if we should load a file from the command line } if (ParamCount > 0) and FileExists(ParamStr(1)) then PerformFileOpen(ParamStr(1)); end; procedure TfrViewTextoRecibo.CheckFileSave; //var // SaveResp: Integer; begin { if not Editor.Modified then Exit; SaveResp := MessageDlg(Format(sSaveChanges, [FFileName]), mtConfirmation, mbYesNoCancel, 0); case SaveResp of idYes: FileSave(Self); idNo: {Nothing}; { idCancel: Abort; end; } end; function TfrViewTextoRecibo.CurrText: TTextAttributes; begin if Editor.SelLength > 0 then Result := Editor.SelAttributes else Result := Editor.DefAttributes; end; procedure TfrViewTextoRecibo.GetFontNames; var DC: HDC; begin DC := GetDC(0); EnumFonts(DC, nil, @EnumFontsProc, Pointer(FontName.Items)); ReleaseDC(0, DC); FontName.Sorted := True; end; procedure TfrViewTextoRecibo.PerformFileOpen(const AFileName: string); begin Editor.Lines.LoadFromFile(AFileName); SetFileName(AFileName); Editor.SetFocus; Editor.Modified := False; SetModified(False); end; procedure TfrViewTextoRecibo.SetEditRect; var R: TRect; begin with Editor do begin R := Rect(GutterWid, 0, ClientWidth-GutterWid, ClientHeight); SendMessage(Handle, EM_SETRECT, 0, Longint(@R)); end; end; procedure TfrViewTextoRecibo.SetFileName(const FileName: String); begin { FFileName := FileName; Caption := Format('%s - %s', [ExtractFileName(FileName), Application.Title]); } end; procedure TfrViewTextoRecibo.SetModified(Value: Boolean); begin if Value then StatusBar.Panels[1].Text := sModified else StatusBar.Panels[1].Text := ''; end; procedure TfrViewTextoRecibo.SetupRuler; var I: Integer; S: String; begin SetLength(S, 201); I := 1; while I < 200 do begin S[I] := #9; S[I+1] := '|'; Inc(I, 2); end; Ruler.Caption := S; end; procedure TfrViewTextoRecibo.UpdateCursorPos; var CharPos: TPoint; begin CharPos.Y := SendMessage(Editor.Handle, EM_EXLINEFROMCHAR, 0, Editor.SelStart); CharPos.X := (Editor.SelStart - SendMessage(Editor.Handle, EM_LINEINDEX, CharPos.Y, 0)); Inc(CharPos.Y); Inc(CharPos.X); StatusBar.Panels[0].Text := Format(sColRowInfo, [CharPos.Y, CharPos.X]); end; procedure TfrViewTextoRecibo.WMDropFiles(var Msg: TWMDropFiles); var CFileName: array[0..MAX_PATH] of Char; begin try if DragQueryFile(Msg.Drop, 0, CFileName, MAX_PATH) > 0 then begin CheckFileSave; PerformFileOpen(CFileName); Msg.Result := 0; end; finally DragFinish(Msg.Drop); end; end; procedure TfrViewTextoRecibo.actClienteExecute(Sender: TObject); begin insertarCadena(FRecibo.Cliente.NOMBRE); end; procedure TfrViewTextoRecibo.actImporteExecute(Sender: TObject); begin insertarCadena(FormatFloat('#,0.00 €', FRecibo.IMPORTE)); end; procedure TfrViewTextoRecibo.actFechaExecute(Sender: TObject); begin insertarCadena(FormatDateTime('"Madrid, " dd "de" mmmm "de" yyyy', FRecibo.FECHARECIBO)); end; procedure TfrViewTextoRecibo.insertarCadena(pCadena: String); var intAux: Integer; begin inherited; intAux := Editor.SelStart+1; Editor.SelText := pCadena; end; function TfrViewTextoRecibo.GetRecibo: IBizRecibosCliente; begin Result := FRecibo; end; procedure TfrViewTextoRecibo.SetRecibo(const Value: IBizRecibosCliente); begin FRecibo := Value; if Assigned(FRecibo) then DADataSource.DataTable := FRecibo.DataTable; end; end.