請教各位前輩,小弟想以DELPHI5附之Demos 中的RichEdit 的語言選項增加中文選擇,程式已添加上述功能,但是執行時無法完成所需功能,不知程式還需作那些修正.
謝謝!!
![]()
附上程式,請指教!
sSaveChanges = 'Save changes to %s?'
sOverWrite = 'OK to overwrite %s'
sUntitled = 'Untitled'
sModified = 'Modified'
sColRowInfo = 'Line: = Col: =' > 0 then Result := Editor.SelAttributes
else Result := Editor.DefAttributes;
end; function EnumFontsProc(var LogFont: TLogFont; var TextMetric: TTextMetric;
FontType: Integer; Data: Pointer): Integer; stdcall;
begin
TStrings(Data).Add(LogFont.lfFaceName);
Result := 1;
end; procedure TMainForm.GetFontNames;
var
DC: HDC;
begin
DC := GetDC(0);
EnumFonts(DC, nil, @EnumFontsProc, Pointer(FontName.Items));
ReleaseDC(0, DC);
FontName.Sorted := True;
end; procedure TMainForm.SetFileName(const FileName: String);
begin
FFileName := FileName;
Caption := Format('%s - %s', [ExtractFileName(FileName), Application.Title]);
end; procedure TMainForm.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; procedure TMainForm.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 TMainForm.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; { Event Handlers } procedure TMainForm.FormCreate(Sender: TObject);
begin
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;
LanguageChinaTaiwan1.tag:=CHINESE;
case SysLocale.DefaultLCID of
ENGLISH: SwitchLanguage(LanguageEnglish);
FRENCH: SwitchLanguage(LanguageFrench);
GERMAN: SwitchLanguage(LanguageGerman);
CHINESE: SwitchLanguage(LanguageChinaTaiwan1);
end;
end; procedure TMainForm.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 TMainForm.FileNew(Sender: TObject);
begin
SetFileName(sUntitled);
Editor.Lines.Clear;
Editor.Modified := False;
SetModified(False);
end; procedure TMainForm.PerformFileOpen(const AFileName: string);
begin
Editor.Lines.LoadFromFile(AFileName);
SetFileName(AFileName);
Editor.SetFocus;
Editor.Modified := False;
SetModified(False);
end; procedure TMainForm.FileOpen(Sender: TObject);
begin
CheckFileSave;
if OpenDialog.Execute then
begin
PerformFileOpen(OpenDialog.FileName);
Editor.ReadOnly := ofReadOnly in OpenDialog.Options;
end;
end; procedure TMainForm.FileSave(Sender: TObject);
begin
if FFileName = sUntitled then
FileSaveAs(Sender)
else
begin
Editor.Lines.SaveToFile(FFileName);
Editor.Modified := False;
SetModified(False);
end;
end; procedure TMainForm.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 TMainForm.FilePrint(Sender: TObject);
begin
if PrintDialog.Execute then
Editor.Print(FFileName);
end; procedure TMainForm.FileExit(Sender: TObject);
begin
Close;
end; procedure TMainForm.EditUndo(Sender: TObject);
begin
with Editor do
if HandleAllocated then SendMessage(Handle, EM_UNDO, 0, 0);
end; procedure TMainForm.EditCut(Sender: TObject);
begin
Editor.CutToClipboard;
end; procedure TMainForm.EditCopy(Sender: TObject);
begin
Editor.CopyToClipboard;
end; procedure TMainForm.EditPaste(Sender: TObject);
begin
Editor.PasteFromClipboard;
end; procedure TMainForm.HelpAbout(Sender: TObject);
begin
with TAboutBox.Create(Self) do
try
ShowModal;
finally
Free;
end;
end; procedure TMainForm.SelectFont(Sender: TObject);
begin
FontDialog1.Font.Assign(Editor.SelAttributes);
if FontDialog1.Execute then
CurrText.Assign(FontDialog1.Font);
SelectionChange(Self);
Editor.SetFocus;
end; procedure TMainForm.RulerResize(Sender: TObject);
begin
RulerLine.Width := Ruler.ClientWidth - (RulerLine.Left*2);
end; procedure TMainForm.FormResize(Sender: TObject);
begin
SetEditRect;
SelectionChange(Sender);
end; procedure TMainForm.FormPaint(Sender: TObject);
begin
SetEditRect;
end; procedure TMainForm.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 TMainForm.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 TMainForm.FontSizeChange(Sender: TObject);
begin
if FUpdating then Exit;
CurrText.Size := StrToInt(FontSize.Text);
end; procedure TMainForm.AlignButtonClick(Sender: TObject);
begin
if FUpdating then Exit;
Editor.Paragraph.Alignment := TAlignment(TControl(Sender).Tag);
end; procedure TMainForm.FontNameChange(Sender: TObject);
begin
if FUpdating then Exit;
CurrText.Name := FontName.Items[FontName.ItemIndex];
end; procedure TMainForm.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 TMainForm.BulletsButtonClick(Sender: TObject);
begin
if FUpdating then Exit;
Editor.Paragraph.Numbering := TNumberingStyle(BulletsButton.Down);
end; procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
try
CheckFileSave;
except
CanClose := False;
end;
end; { Ruler Indent Dragging } procedure TMainForm.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 TMainForm.RulerItemMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
begin
if FDragging then
TLabel(Sender).Left := TLabel(Sender).Left X-FDragOfs
end; procedure TMainForm.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 TMainForm.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 TMainForm.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 TMainForm.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 TMainForm.FormShow(Sender: TObject);
begin
UpdateCursorPos;
DragAcceptFiles(Handle, True);
RichEditChange(nil);
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 TMainForm.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 TMainForm.RichEditChange(Sender: TObject);
begin
SetModified(Editor.Modified);
end; procedure TMainForm.SetModified(Value: Boolean);
begin
if Value then StatusBar.Panels[1].Text := sModified
else StatusBar.Panels[1].Text := '';
end; procedure TMainForm.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;
LanguageChinaTaiwan1.Checked:= LanguageChinaTaiwan1 =Sender; CurrText.Name := Name;
CurrText.Size := Size;
SelectionChange(Self);
FontName.SelLength := 0; SetupRuler;
if Visible then Editor.SetFocus;
end;
end; procedure TMainForm.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; end.
發表時間：2003-07-20 18:58:01
IP:61.231.xxx.xxx 未訂閱
網海無涯，學無止境!