foutput.pas

Delphi编写的一个支持语法高亮显示和很多语言的文本编辑器

unit fOutput;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, DosCommand, StdCtrls, DockPanel, dMain, SynEdit,
  SynMemo, Tabs, ComCtrls, Menus, fTask, strUtils, Grids;

type
  TfrmOutput = class(TDockableForm)
    Dos: TDosCommand;
    pnlOutput: TPanel;
    tsSet: TTabSet;
    lstTask: TListView;
    popTask: TPopupMenu;
    NewTask1: TMenuItem;
    EditTask1: TMenuItem;
    DeleteTask1: TMenuItem;
    N1: TMenuItem;
    DrawGrid: TDrawGrid;
    Panel: TPanel;
    synOutput: TListBox;
    procedure DosNewLine(Sender: TObject; NewLine: String;
      OutputType: TOutputType);
    procedure lstTaskResize(Sender: TObject);
    procedure tsSetChange(Sender: TObject; NewTab: Integer;
      var AllowChange: Boolean);
    procedure NewTask1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure EditTask1Click(Sender: TObject);
    procedure DeleteTask1Click(Sender: TObject);
    procedure DrawGridDrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure DrawGridSelectCell(Sender: TObject; ACol, ARow: Integer;
      var CanSelect: Boolean);
    procedure DrawGridDblClick(Sender: TObject);
    procedure PanelClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure lstTaskDblClick(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure synOutputDblClick(Sender: TObject);
  private
    procedure LoadList;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmOutput: TfrmOutput;

implementation

uses fMain;

{$R *.dfm}

procedure TfrmOutput.DosNewLine(Sender: TObject; NewLine: String;
  OutputType: TOutputType);
begin
  synOutput.Items.Add(NewLine);
  synOutput.ItemIndex := synOutput.Items.Count - 1;
end;

procedure TfrmOutput.lstTaskResize(Sender: TObject);
begin
  lstTask.Columns.Items[2].Width := lstTask.ClientWidth - lstTask.Columns.Items[0].Width - lstTask.Columns.Items[1].Width;
end;

procedure TfrmOutput.tsSetChange(Sender: TObject; NewTab: Integer;
  var AllowChange: Boolean);
begin
  Case NewTab of
    0:
      lstTask.BringToFront;
    1:
      synOutput.BringToFront;
    2: begin
      DrawGrid.BringToFront;
      Panel.BringToFront;
    end;
  end;
end;

procedure TfrmOutput.NewTask1Click(Sender: TObject);
begin
  lstTask.ItemIndex := -1;
  with TfrmTask.Create(nil) do begin
    ShowModal;
  end;
end;

procedure tFrmOutput.LoadList;
var
  strOpen: TstringList;
  ps: TProgressBar;
  i,b: Integer;
  c: integer;
begin
  if not FIleExists(ExtractFilePath(application.exename) + 'data\tasks.tsk') then exit;
  strOpen := TStringList.Create;
  strOpen.LoadFromFile(ExtractFilePath(application.exename) + 'data\tasks.tsk');
  for i:=0 to (strOpen.Count div 3) - 1 do begin
    b := i * 3;
    With lstTask.Items.Add do begin
      Caption := strOpen[b];
      c := StrToInt(leftStr(strOpen[b+1], Pos('%', strOpen[b+1])-1));
      c := c div 10;
      if c = 10 then Checked := True;
      ps := TProgressBar.Create(lstTask);
      SubItems.AddObject(strOpen[b+1], ps);
      ps.Left := 0;
      ps.Top := 0;
      ps.Width := lstTask.Column[1].Width;
      ps.Height := 100;
      ps.Max := 10;
      ps.Min := 0;
      ps.Position := StrToInt(LeftStr(strOpen[b+1], StrLen(PChar(strOpen[b+1])) - 1));
      ps.Visible := True;
//      SubItems.Add(strOpen[b+1]);
      SubItems.Add(strOpen[b+2]);
    end;
  end;
  strOpen.Free;
end;

procedure TfrmOutput.FormCreate(Sender: TObject);
begin
  LoadList;
end;

procedure TfrmOutput.EditTask1Click(Sender: TObject);
var
  i: Integer;
begin
  with TfrmTask.Create(nil) do begin
    edtID.Text := lstTask.Selected.Caption;
    i := StrToInt(leftStr(lstTask.Selected.SubItems[0], Pos('%', lstTask.Selected.SubItems[0])-1));
    i := i div 10;
    trkPercent.Position := i;
    edtDesc.Text := lstTask.Selected.SubItems[1];
    ShowModal;
  end;
end;

procedure TfrmOutput.DeleteTask1Click(Sender: TObject);
var
  strSave: TStringList;
  i: Integer;
begin
  lstTask.Selected.Delete;
  strSave := TStringList.Create;
  for i:=0 to lstTask.Items.Count - 1 do begin
    With lstTask.Items do begin
      strSave.Add(Item[i].Caption);
      strSave.Add(Item[i].SubItems[0]);
      strSave.Add(Item[i].SubItems[1]);
    end;
  end;
  strSave.SaveToFile(ExtractFilePath(application.exename) + 'data\tasks.tsk');
end;

procedure TfrmOutput.DrawGridDrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
Var
  Text: String;
  Size: TSize;
Begin
  Text := Chr( ( ACol + ( 28 * ARow ) ) + 32 );
  Size := DrawGrid.Canvas.TextExtent( Text );
  DrawGrid.Canvas.TextRect( Rect, ( ( ( Rect.Right - Rect.Left ) Div 2 ) - ( Size.CX Div 2 ) ) + Rect.Left, Rect.Top + 2, Text );

end;

procedure TfrmOutput.DrawGridSelectCell(Sender: TObject; ACol,
  ARow: Integer; var CanSelect: Boolean);
begin
  Panel.Visible := True;

  Panel.Font.Name := DrawGrid.Font.Name;

  Panel.Left := DrawGrid.Left + ACol * 17;
  If Panel.Left + Panel.Width > DrawGrid.Left + DrawGrid.Width Then
    Panel.Left := DrawGrid.Left + DrawGrid.Width - Panel.Width;

  Panel.Top := DrawGrid.Top + ARow * 19;
  If Panel.Top + Panel.Height > DrawGrid.Top + DrawGrid.Height Then
    Panel.Top := DrawGrid.Top + DrawGrid.Height - Panel.Height;

  Panel.Caption := Chr( ( ACol + ( 28 * ARow ) ) + 32 );

end;

procedure TfrmOutput.DrawGridDblClick(Sender: TObject);
begin
  if dmMain.SelDoc <> nil then
    dmMain.SelDoc.sciMain.SelText := Chr( ( DrawGrid.Col + ( 28 * DrawGrid.Row ) ) + 32 );

end;

procedure TfrmOutput.PanelClick(Sender: TObject);
begin
  if dmMain.SelDoc <> nil then
    dmMain.SelDoc.sciMain.SelText := Chr( ( DrawGrid.Col + ( 28 * DrawGrid.Row ) ) + 32 );

end;

procedure TfrmOutput.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  frmMain.DebugOutput2.Checked := False;
end;

procedure TfrmOutput.lstTaskDblClick(Sender: TObject);
begin
  if lstTask.Selected <> nil then
    EditTask1Click(nil)
  else
    NewTask1Click(nil);
end;

procedure TfrmOutput.FormResize(Sender: TObject);
begin
  lstTaskResize(nil);
end;

function InStr(sStart: integer; const sData: string; const
    sFind: string): integer;
    var
      c: integer; 
    label
      SkipFind;
    begin
      c := sStart - 1; 
      repeat
        if c > length(sData) then
        begin 
          c := 0; 
          goto SkipFind; 
        end; 
        inc(c); 
      until copy(sData, c, length(sFind)) = sFind; 
    SkipFind:
      Result := c; 
end;


procedure TfrmOutput.synOutputDblClick(Sender: TObject);
var
  d: Integer;
  i: TSynEditMark;
begin
  d := pos('on line ', synOutput.Items[synOutput.ItemIndex]);
  if d <> 0 then begin
    d := StrToInt(MidStr(synOutput.Items[synOutput.ItemIndex], d + StrLen('on line '), Instr(d + StrLen('on line '),synOutput.Items[synOutput.ItemIndex], ' ') - (d + StrLen('on line '))));
    if dmMain.selDoc <> nil then begin
      dmMain.SelDoc.sciMain.CaretY := d;
      i := TSynEditMark.Create(dmmain.SelDoc.sciMain);
      i.Line := d;
      dmMain.SelDoc.sciMain.Marks.Add(i);

      WIndows.SetFocus(dmMain.SelDoc.sciMain.Handle);

      dmMain.SelDoc.sciMain.SetFocus;

    end;
  end;
end;

end.