MathgeomGLS
575 строк · 14.4 Кб
1unit fTextBlocks;2
3interface
4
5uses
6Winapi.Windows,7Winapi.Messages,8System.UITypes,9System.SysUtils,10System.Variants,11System.Classes,12Vcl.Graphics,13Vcl.Controls,14Vcl.Forms,15Vcl.Dialogs,16Vcl.StdCtrls,17Vcl.ComCtrls,18Vcl.CheckLst,19Vcl.Buttons,20Vcl.ExtCtrls,21
22uGlobal;23
24type
25TTextBlocksForm = class(TForm)26RichEdit: TRichEdit;27BlockListBox: TCheckListBox;28ApplyBitBtn: TBitBtn;29BitBtn1: TBitBtn;30Label2: TLabel;31EditLeft: TEdit;32EditTop: TEdit;33Label3: TLabel;34EditLineHeight: TEdit;35UpDown1: TUpDown;36ColorButton: TSpeedButton;37ColorPanel: TPanel;38FontButton: TSpeedButton;39Label1: TLabel;40AddButton: TSpeedButton;41DeleteButton: TSpeedButton;42UpButton: TSpeedButton;43DownButton: TSpeedButton;44EditCaption: TEdit;45FontDialog: TFontDialog;46ColorDialog: TColorDialog;47procedure FormDestroy(Sender: TObject);48procedure FormShow(Sender: TObject);49procedure FloatKeyPress(Sender: TObject; var Key: Char);50procedure IntKeyPress(Sender: TObject; var Key: Char);51procedure EditKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);52procedure EditLeftKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);53procedure EditTopKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);54procedure EditCaptionKeyUp(Sender: TObject; var Key: Word;55Shift: TShiftState);56procedure IntKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);57procedure LineHeightChange(Sender: TObject);58procedure BitBtn1Click(Sender: TObject);59procedure ApplyBitBtnClick(Sender: TObject);60procedure FontButtonClick(Sender: TObject);61procedure AddButtonClick(Sender: TObject);62procedure BlockListBoxClick(Sender: TObject);63procedure ColorPanelClick(Sender: TObject);64procedure RichEditChange(Sender: TObject);65procedure BlockListBoxClickCheck(Sender: TObject);66procedure DeleteButtonClick(Sender: TObject);67procedure UpButtonClick(Sender: TObject);68procedure DownButtonClick(Sender: TObject);69procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);70private71
72TextData: TTextData;73function DefaultData: TTextData;74procedure UpdateTextLines;75public76
77procedure ClearTextBlocks;78procedure UpdateRichLines;79procedure ShowData(Sender: TObject);80end;81
82var
83TextBlocksForm: TTextBlocksForm;84
85const
86yIncFactor = 1.65;87
88//=====================================================================
89implementation
90//=====================================================================
91
92uses
93fPlot1D;94
95{$R *.dfm}
96
97procedure TTextBlocksForm.FormCloseQuery(Sender: TObject;98var CanClose: Boolean);99begin
100if ApplyBitBtn.Visible then101begin102case MessageDlg('The current data has been altered.'+103#13#10'To save the change press the Apply Change Button.'+104#13#10'Do you wish to save the alterations ?', mtConfirmation,105[mbYes, mbNo], 0) of106mrYes: CanClose := False;107end;108end;109end;110
111procedure TTextBlocksForm.FormDestroy(Sender: TObject);112var
113i: integer;114
115begin
116for i := 0 to BlocklistBox.Count - 1117do BlockListBox.Items.Objects[i].Free;118RichEdit.Clear;119end;120
121procedure TTextBlocksForm.FormShow(Sender: TObject);122begin
123Caption := GraphFName;124if BlockListBox.Count = 0 then TextData := DefaultData125else126begin127UpdateRichLines;128ColorPanel.Color := RichEdit.DefAttributes.Color;129with BlockListBox do130TextData := TTextDataObject(Items.Objects[ItemIndex]).Data;131with FontDialog.Font, TextData do132begin133Name := FontName;134Size := FontSize;135Style := FontStyle;136Color := ColorPanel.Color;137end;138end;139ShowData(Sender);140end;141
142procedure TTextBlocksForm.FloatKeyPress(Sender: TObject; var Key: Char);143begin
144with Sender as TEdit do145if not CharInSet(Key, ['-', '0'..'9', '.', 'e', 'E', #8]) then Key := #0146else if Active then ApplyBitBtn.Visible := RichEdit.Lines.Count > 0;147end;148
149procedure TTextBlocksForm.IntKeyPress(Sender: TObject; var Key: Char);150begin
151with Sender as TEdit do152if not CharInSet(Key, ['0'..'9', #8]) then Key := #0153else ApplyBitBtn.Visible := RichEdit.Lines.Count > 0;154end;155
156procedure TTextBlocksForm.EditKeyDown(Sender: TObject; var Key: Word;157Shift: TShiftState);158begin
159if (Key = VK_DELETE) or (Key = VK_BACK)160then ApplyBitBtn.Visible := RichEdit.Lines.Count > 0;161end;162
163procedure TTextBlocksForm.EditLeftKeyUp(Sender: TObject; var Key: Word;164Shift: TShiftState);165begin
166with TextData do167try168xLoc := StrToFloat(EditLeft.Text);169except170if GraphData.Grid.xAxisStyle = asLog then xLoc := 0.1 else xLoc := -0.1;171end;172with BlockListBox do173TTextDataObject(Items.Objects[ItemIndex]).Data.xLoc := TextData.xLoc;174ApplyBitBtn.Visible := RichEdit.Lines.Count > 0;175end;176
177procedure TTextBlocksForm.EditTopKeyUp(Sender: TObject; var Key: Word;178Shift: TShiftState);179begin
180with TextData do181try182yLoc := StrToFloat(EditTop.Text);183except184if GraphData.Grid.yAxisStyle = asLog then yLoc := 0.1 else yLoc := -0.1;185end;186with BlockListBox do187TTextDataObject(Items.Objects[ItemIndex]).Data.yLoc := TextData.yLoc;188ApplyBitBtn.Visible := RichEdit.Lines.Count > 0;189end;190
191procedure TTextBlocksForm.EditCaptionKeyUp(Sender: TObject; var Key: Word;192Shift: TShiftState);193begin
194with BlockListBox do195begin196TTextDataObject(Items.Objects[ItemIndex]).Data.Caption := EditCaption.Text;197Items[ItemIndex] := EditCaption.Text;198end;199end;200
201procedure TTextBlocksForm.RichEditChange(Sender: TObject);202begin
203if Active then204begin205ApplyBitBtn.Visible := (BlockListBox.Count > 0) and206(TTextDataObject(BlockListBox.Items.Objects[BlockListBox.ItemIndex]).207TextLines.Count > 0) and (RichEdit.Lines.Count > 0);208end;209end;210
211procedure TTextBlocksForm.IntKeyUp(Sender: TObject; var Key: Word;212Shift: TShiftState);213begin
214if Active then215begin216with Sender as TEdit do217try218TextData.yInc := StrToInt(Text);219except220TextData.yInc := round(TextData.FontSize*yIncFactor);221end;222with BlockListBox do223TTextDataObject(Items.Objects[ItemIndex]).Data.yInc := TextData.yInc;224ApplyBitBtn.Visible := RichEdit.Lines.Count > 0;225end;226end;227
228procedure TTextBlocksForm.LineHeightChange(Sender: TObject);229var
230k: word;231
232begin
233if Active then234begin235k := 0;236IntKeyUp(Sender, k, []);237end;238end;239
240procedure TTextBlocksForm.BitBtn1Click(Sender: TObject);241begin
242Close;243end;244
245procedure TTextBlocksForm.ApplyBitBtnClick(Sender: TObject);246begin
247UpdateTextLines;248Altered := True;249MainForm.GLViewer.Invalidate;250ApplyBitBtn.Visible := False;251end;252
253procedure TTextBlocksForm.FontButtonClick(Sender: TObject);254var
255Cpos: integer;256i: integer;257
258begin
259if RichEdit.Lines.Count = 0 then RichEdit.Lines.Add('Sample text.');260UpdateTextLines;261Cpos := RichEdit.SelStart;262
263if FontDialog.Execute then264begin265with TextData, FontDialog.Font do266begin267FontName := Name;268FontStyle := Style;269FontSize := Size;270FontColor := Color;271yInc := round(FontSize*yIncFactor);272ColorPanel.Color := FontColor;273UpDown1.Position := yInc;274end;275
276with FontDialog,277TTextDataObject(BlockListBox.Items.Objects[BlockListBox.ItemIndex]) do278begin279with Data do280begin281FontName := Font.Name;282FontStyle := Font.Style;283FontSize := Font.Size;284FontColor := Font.Color;285yInc := round(FontSize*yIncFactor);286
287with RichEdit do if Lines.Count > 0 then288begin289UpdateTextLines;290TextLines.Clear;291for i := 0 to Lines.Count -1292do TextLines.Add(TTextLineObject.Create(Lines[i], FontColor));293Lines.Clear;294with DefAttributes do295begin296Name := FontName;297Style := FontStyle;298Size := FontSize;299Color := FontColor;300end;301for i := 0 to TextLines.Count -1 do302with TTextLineObject(TextLines[i]) do Lines.Add(Text);303end;304
305end;306end;307RichEdit.SelStart := Cpos;308ApplyBitBtn.Visible := RichEdit.Lines.Count > 0;309end;310end;311
312procedure TTextBlocksForm.AddButtonClick(Sender: TObject);313begin
314with BlockListBox do315begin316if Count = 0 then TextData := DefaultData317else TextData := TTextDataObject(Items.Objects[ItemIndex]).Data;318
319with FontDialog.Font, TextData do320begin321Name := FontName;322Size := FontSize;323Style := FontStyle;324Color := FontColor;325end;326
327with TextData do Caption := 'Text Block';328AddItem(TextData.Caption, TTextDataObject.Create(TextData));329ItemIndex := Count -1;330Checked[ItemIndex] := True;331RichEdit.Clear;332end;333ShowData(Sender);334EditCaption.SetFocus;335FontButtonClick(Sender);336end;337
338procedure TTextBlocksForm.BlockListBoxClick(Sender: TObject);339begin
340with BlockListBox do341TextData := TTextDataObject(Items.Objects[ItemIndex]).Data;342
343with FontDialog.Font, TextData do344begin345Name := FontName;346Size := FontSize;347Style := FontStyle;348Color := FontColor;349ColorPanel.Color := Color;350end;351
352UpdateRichLines;353ShowData(Sender);354end;355
356procedure TTextBlocksForm.BlockListBoxClickCheck(Sender: TObject);357begin
358ApplyBitBtn.Visible := True;359end;360
361procedure TTextBlocksForm.ColorPanelClick(Sender: TObject);362var
363Cpos: integer;364idx: cardinal;365s: string;366
367begin
368with RichEdit do369begin370if Lines.Count = 0 then371begin372Lines.Add('Sample text.');373UpdateTextLines;374SelStart := 1;375end;376
377Cpos := SelStart;378
379if ActiveLineNo >= cardinal(Lines.Count) then SelStart := Length(Text) -1;380end;381MainForm.StatusBar.Panels[2].Text := '';382
383ColorDialog.Color := ColorPanel.Color;384if ColorDialog.Execute then385begin386ColorPanel.Color := ColorDialog.Color;387with RichEdit do388begin389Idx := ActiveLineNo;390s := Lines[Idx];391Lines.Delete(Idx);392SelAttributes.Color := ColorPanel.Color;393Lines.Insert(Idx, s);394end;395end;396
397RichEdit.SelStart := cPos;398ApplyBitBtn.Visible := RichEdit.Lines.Count > 0;399end;400
401function TTextBlocksForm.DefaultData: TTextData;402begin
403with Result do404begin405Caption := 'Text Block #';406xLoc := 0.0;407yLoc := 0.0;408FontName := 'Tahoma';409FontStyle := [];410FontSize := 12;411FontColor := clBlack;412yInc := round(FontSize*yIncFactor);413end;414end;415
416procedure TTextBlocksForm.DeleteButtonClick(Sender: TObject);417var
418i: integer;419
420begin
421if BlockListBox.Count > 0 then422begin423RichEdit.Clear;424with BlockListBox do425begin426i := ItemIndex;427with Items.Objects[i] as TTextDataObject do Free;428Items.Delete(i);429if i > Count -1 then i := Count -1;430ItemIndex := i;431DeleteButton.Enabled := Count > 0;432end;433
434if BlockListBox.Count > 0 then BlockListBoxClick(Sender);435ApplyBitBtn.Visible := True;436end;437end;438
439procedure TTextBlocksForm.DownButtonClick(Sender: TObject);440var
441i: integer;442
443begin
444with BlockListBox do445begin446i := ItemIndex;447if i < Count -1 then Items.Move(i, i+1);448ItemIndex := i+1;449end;450BlockListBoxClick(Sender);451end;452
453procedure TTextBlocksForm.ShowData(Sender: TObject);454var
455a: Boolean;456
457begin
458{ if BlockListBox.Count = 0 then disable all except AddButton }
459a := Altered;460RichEdit.Color := GraphData.BackColor;461DeleteButton.Enabled := BlockListBox.Count > 0;462UpButton.Enabled := DeleteButton.Enabled and (BlockListBox.Count > 1);463DownButton.Enabled := DeleteButton.Enabled and (BlockListBox.Count > 1);464FontButton.Enabled := DeleteButton.Enabled;465BlockListBox.Enabled := DeleteButton.Enabled;466EditCaption.Enabled := DeleteButton.Enabled;467EditLeft.Enabled := DeleteButton.Enabled;468EditTop.Enabled := DeleteButton.Enabled;469EditLineHeight.Enabled := DeleteButton.Enabled;470upDown1.Enabled := DeleteButton.Enabled;471ColorButton.Enabled := DeleteButton.Enabled;472ColorPanel.Enabled := DeleteButton.Enabled;473RichEdit.Enabled := DeleteButton.Enabled;474ApplyBitBtn.Visible := Active and (Sender.ClassName <> 'TSpeedButton') and475(RichEdit.Lines.Count > 0);476
477with BlockListBox do if Count > 0 then478begin;479with TTextDataObject(Items.Objects[ItemIndex]).Data do480begin481EditCaption.Text := Caption;482EditLeft.Text := FloatToStrF(xLoc, ffGeneral, 4, 3);483EditTop.Text := FloatToStrF(yLoc, ffGeneral, 4, 3);484EditLineHeight.Text := IntToStr(yInc);485
486with RichEdit, TTextDataObject(Items.Objects[ItemIndex]) do487if (Lines.Count > 1) and (ActiveLineNo < cardinal(Lines.Count))488then ColorDialog.Color := TTextLineObject(TextLines[ActiveLineNo]).Color;489end;490end;491Altered := a;492end;493
494procedure TTextBlocksForm.UpButtonClick(Sender: TObject);495var
496i: integer;497
498begin
499with BlockListBox do500begin501i := ItemIndex;502if i > 0 then Items.Move(i, i-1);503if i > 1 then ItemIndex := i-1 else ItemIndex := 0;504end;505BlockListBoxClick(Sender);506end;507
508procedure TTextBlocksForm.UpdateTextLines;509var
510i: integer;511
512begin
513with BlockListBox, TTextDataObject(Items.Objects[ItemIndex]) do514begin515for i := 0 to TextLines.Count -1 do516begin517TTextLineObject(TextLines.Items[i]).Free;518end;519TextLines.Clear;520end;521
522RichEdit.SelStart := 0;523with BlockListBox, TTextDataObject(Items.Objects[ItemIndex]) do524for i := 0 to RichEdit.Lines.Count -1 do525begin526TextLines.Add(TTextLineObject.Create(RichEdit.Lines[i],527RichEdit.SelAttributes.Color));528
529RichEdit.SelStart := RichEdit.SelStart + Length(RichEdit.Lines[i]) +1;530end;531end;532
533procedure TTextBlocksForm.UpdateRichLines;534var
535i: integer;536
537begin
538with TTextDataObject(BlockListBox.Items.Objects[BlockListBox.ItemIndex]) do539begin540with RichEdit.DefAttributes do541begin542Name := Data.FontName;543Style := Data.FontStyle;544Size := Data.FontSize;545Color := Data.FontColor;546end;547
548with RichEdit do549begin550Lines.Clear;551for i := 0 to TextLines.Count -1 do552with TTextLineObject(TextLines.Items[i]) do553begin554SelAttributes.Color := Color;555Lines.Add(Text);556end;557end;558end;559end;560
561procedure TTextBlocksForm.ClearTextBlocks;562var
563i: integer;564
565begin
566with BlockListBox do567begin568for i := 0 to Count -1 do Items.Objects[i].Free;569Clear;570end;571
572RichEdit.Clear;573end;574
575end.576