mainform.pas

一个模拟Delphi的快速开发环境RAD

       SaveDialog1.FilterIndex:=1;
       if SaveDialog1.Execute then  begin
          ProjectInfo.ProjectSource.SaveToFile(SaveDialog1.FileName);
          ProjectInfo.ProjectPath:=ExtractFilePath(SaveDialog1.FileName);
       end;
       Exit;
    end
    else if ExtractFileExt(FileName)='.pas' then begin
       SaveDialog1.FileName:=FileName;
       SaveDialog1.FilterIndex:=2;
       LinkForm:= GetLinkForm;
       EditorForm.GetLinkEditor.PlainText:=True;
       if SaveDialog1.Execute then  begin
          SaveName:=SaveDialog1.FileName;
          SaveForm(LinkForm,Copy(SaveName,1,Length(SaveName)-4)+'.dfm');
       end
       else Exit;
    end;
    if FileExists(SaveName) then begin
       SaveResp := MessageDlg(Format('Same filename exists already! Save changes to %s?',
                [ExtractFileName(SaveName)]), mtWarning, mbYesNoCancel, 0);
       case SaveResp of
            idYes:
               EditorForm.GetLinkEditor.Lines.SaveToFile(SaveName);
            idNo: {Nothing};
            idCancel: Abort;
       end;
    end
    else if FileName <> SaveName then begin
      EditorForm.RenameUnit(SaveName);
      EditorForm.GetLinkEditor.Lines.SaveToFile(SaveName);
    end
    else
      EditorForm.GetLinkEditor.Lines.SaveToFile(SaveName);
end;

// 汽苞 蜡聪飘甫 配臂窍搁辑 劝己拳茄促.
procedure TFMainForm.sbToggleUnitClick(Sender: TObject);
begin
   ToggleFormAndUnit;
end;

procedure TFMainForm.SetProjectInfo(const ProjectName:string);
// 橇肺璃飘俊 包茄 沥焊甫 汲沥茄促.
var
   NewItem:TListItem;
   txtFile:TextFile;
   txtLine:string;
   NamePos,FormPos,FormEndPos:integer;
   I:integer;
begin
    AssignFile(txtFile,ProjectName);
    Reset(txtFile);
    ProjectInfo.UnitItems.Clear;
    ProjectInfo.FormItems.Clear;
    ProjectInfo.ProjectPath:= ExtractFilePath(ProjectName);
    while not EOF(txtFile) do begin
        Readln(txtFile,txtLine);
        if Pos('{$R',txtLine)>0 then Break;   // 橇肺璃飘狼 格废阑 葛滴 佬菌栏搁 狐廉唱皑
        NamePos:=Pos(' in',txtLine);           // 蜡聪飘 颇老捞 场唱绰 困摹
        if NamePos>0 then begin
           FormPos:=Pos('{',txtLine);         // 汽狼 矫累 困摹
           FormEndPos:=Pos('}',txtLine);      // 汽 颇老狼 场 困摹
           with ProjectInfo do begin
              UnitItems.Add(Trim(Copy(txtLine,1,NamePos-1)));   // 蜡聪飘 格废
              FormItems.Add(Copy(txtLine,FormPos+1,FormEndPos-FormPos-1)); // 汽 格废
           end;
        end;
     end;
     CloseFile(txtFile);
     ProjectInfo.ProjectSource.LoadFromFile(ProjectName);
     ProjectInfo.UpdateProject(self);
     ProjectInfo.ProjectState:=psOpen;
end;

procedure TFMainForm.NHideClick(Sender: TObject);
begin
    SpeedBar.Visible:=False;
    ViewSpeedBarItem.Checked:=False;
end;

procedure TFMainForm.ToolsOptionsItemClick(Sender: TObject);
begin
    CreateShowModal(TOptions);
end;

procedure TFMainForm.NImageEditClick(Sender: TObject);
var
   ret:integer;
begin
    Screen.Cursor:=crHourGlass;
    ret:=WinExec(PChar(Complier+'IMAGEDIT.EXE'),SW_SHOWNORMAL);
    if ret<31 then ShowMessage('Cannot Execute Program !');
    Screen.Cursor:=crDefault;
end;

procedure TFMainForm.NDatabaseDestopClick(Sender: TObject);
var
   ret:integer;
begin
    Screen.Cursor:=crHourGlass;
    ret:=WinExec(PChar(DESKTOP+'DBD32.EXE'),SW_SHOWNORMAL);
    if ret<31 then ShowMessage('Cannot Execute Program!');
    Screen.Cursor:=crDefault;
end;

procedure TFMainForm.ProjectOptionsItemClick(Sender: TObject);
begin
    CreateShowModal(TProjOption);
end;

// 汽 颇老阑 佬绰呆.
procedure TFMainForm.OpenForm(const FileName:string);
var
   Input,Output:TMemoryStream;
   Form:TForm;
   I:Integer;
begin
    if not FileExists(FileName) then Exit;
    Form:=CreateProxy(TProxyForm,GetNetFileName(FileName)) as TForm;
    Input:=TMemoryStream.Create;
    Input.LoadFromFile(FileName);
    Output:=TMemoryStream.Create;
    ObjectResourceToText(Input,Output);
    Output.SaveToFile(TempFile);
    SourceList.LoadFromFile(TempFile);
    Input.Position:=0;
    ReadClass;
    try
       Input.ReadComponentRes(Form);
    finally
       Input.Free;
       OutPut.Free;
       Form.Designer:= TProxyDesigner.Create(Form);
       ProxyDesigner := TProxyDesigner(Form.Designer);
       ProxyDesigner.GetComponentList;
       SelectUnit:= FileName;
       Form.Show;
       ActiveForm:=Form;
    end;
    // 哪欺惩飘甫 急琶且 荐 乐档废 ComponentState甫 csDesigning栏肺 汲沥茄促.
    for I:=0 to Form.ComponentCount - 1 do
      TExposeComponent(Form.Components[I]).SetDesigning(True);
end;

procedure TFMainForm.NewProject;
var
   List: TStringList;
begin
    ProjectInfo.ProjectPath:=TempDir;
    with ProjectInfo do begin
        ProjectState:=psNew;
        UnitItems.Clear;
        FormItems.Clear;
        ProjectName:=TempDir+TempProject;
        UnitItems.Add('Unit1.pas');
        FormItems.Add('Form1');
    end;
    // 货肺款 橇肺璃飘 颇老狼 内靛甫 积己
    List:=TStringList.Create;
    List:=CreateDefaultProject(List);
  //  List.SaveToFile(TempDir+TempProject);
    Caption:=Application.Title;
end;

function TFmainForm.GetUniqueUnitName:string;
// 橇肺璃飘俊辑 蜡老茄 蜡聪飘 捞抚阑 倒妨霖促.
var
   I,Count:Integer;
begin
    Result:='Unit1.pas';
    Count:=1;
    if  ProjectInfo.UnitItems.Count<1 then Exit;
    for I:=0 to ProjectInfo.UnitItems.Count-1 do
    begin
        if Pos('Unit',ProjectInfo.UnitItems[I])>0 then Inc(Count);
    end;
    Result:='Unit'+IntToStr(Count)+'.pas';
end;

function TFmainForm.GetUniqueFormName:string;
var
   I,Count:Integer;
begin
    Result:='Form1.dfm';
    Count:=1;
    if  ProjectInfo.FormItems.Count<1 then Exit;
    for I:=0 to ProjectInfo.FormItems.Count-1 do
    begin
        if Pos('Form',ProjectInfo.FormItems[I])>0 then Inc(Count);
    end;
    Result:='Form'+IntToStr(Count)+'.dfm';
end;

procedure TFMainForm.FormResize(Sender: TObject);
begin
  // ProxyDesigner.PaintGrid;
end;

function TFMainForm.GetSelectComponent:TComponentClass;
var
   SelectClass:TComponentClass;
begin
    SelectClass:= nil;
    case SelectedComponentIndex of
         scNoComponent:  SelectClass:=nil;
         scMainMenu:          SelectClass:=TMainMenu;
         scPopupMenu:         SelectClass:=TPopupMenu;
         scButton:            SelectClass:=TButton;
         scLabel:             SelectClass:=TLabel;
         scEdit:              SelectClass:=TEdit;
         scMemo:              SelectClass:=TMemo;
         scCheckBox:          SelectClass:=TCheckBox;
         scRadioButton:       SelectClass:=TRadioButton;
         scListBox:           SelectClass:=TListBox;
         scGroupBox:          SelectClass:=TGroupBox;
         scScrollBox:         SelectClass:=TScrollBox;
         scScrollBar:         SelectClass:=TScrollBar;
         scComboBox:          SelectClass:=TComboBox;
         scPanel:             SelectClass:=TPanel;
         scRadioGroup:        SelectClass:=TRadioGroup;

         scBitBtn:            SelectClass:=TBitBtn;
         scSpeedButton:       SelectClass:=TSpeedButton;
         scMaskEdit:          SelectClass:=TMaskEdit;
         scStringGrid:        SelectClass:=TStringGrid;
         scDrawGrid:          SelectClass:=TDrawGrid;
         scImage:             SelectClass:=TImage;
         scShape:             SelectClass:=TShape;
         scBevel:             SelectClass:=TBevel;

         scTabControl:        SelectClass:=TTabControl;
         scPageControl:       SelectClass:=TPageControl;
         scRichEdit:          SelectClass:=TRichEdit;
         scTrackBar:          SelectClass:=TTrackBar;
         scImageList:         SelectClass:=TImageList;
         scProgressBar:       SelectClass:=TProgressBar;
         scUpDown:            SelectClass:=TUpDown;
         scHotKey:            SelectClass:=THotKey;
         scTreeView:          SelectClass:=TTreeView;
         scListView:          SelectClass:=TListView;
         scHeaderControl:     SelectClass:=THeaderControl;
         scStatusBar:         SelectClass:=TStatusBar;

         scDataSource:    SelectClass:=TDataSource;
         scTable :        SelectClass:=TTable;
         scQuery :        SelectClass:=TQuery;
         scDatabase :     SelectClass:=TDatabase;
         scStoredProc :   SelectClass:=TStoredProc;
         scSession :      SelectClass:=TSession;
         scBatchMove :    SelectClass:=TBatchMove;
         scUpdateSQL :    SelectClass:=TUpdateSQL;

         scDBGrid:            SelectClass:=TDBGrid;
         scDBNavigator:       SelectClass:=TDBNavigator;
         scDBText:            SelectClass:=TDBText;
         scDBEdit:            SelectClass:=TDBEdit;
         scDBMemo:            SelectClass:=TDBMemo;
         scDBImage:           SelectClass:=TDBImage;
         scDBListBox:         SelectClass:=TDBListBox;
         scDBComboBox:        SelectClass:=TDBComboBox;
         scDBCheckBox:        SelectClass:=TDBCheckBox;
         scDBRadioGroup:      SelectClass:=TDBRadioGroup;
         scDBLookupListBox:   SelectClass:=TDBLookupListBox;
         scDBLookupComboBox:  SelectClass:=TDBLookupComboBox;

         scOpenDialog:        SelectClass:=TOpenDialog;
         scSaveDialog:        SelectClass:=TSaveDialog;
         scFontDialog:        SelectClass:=TFontDialog;
         scColorDialog:       SelectClass:=TColorDialog;
         scPrintDialog:       SelectClass:=TPrintDialog;
         scPrinterSetupDialog:SelectClass:=TPrinterSetupDialog;
         scFindDialog:        SelectClass:=TFindDialog;
         scReplaceDialog:     SelectClass:=TReplaceDialog;

         scTimer:             SelectClass:=TTimer;
         scPaintBox:          SelectClass:=TPaintBox;
         scFileListBox:       SelectClass:=TFileListBox;
         scDirectoryListBox:  SelectClass:=TDirectoryListBox;
         scDriveComboBox:     SelectClass:=TDriveComboBox;
         scFilterComboBox:    SelectClass:=TFilterComboBox;
         scMediaPlayer:       SelectClass:=TMediaPlayer;
         // Quick Report Page
         scQuickReport:       SelectClass:=TQuickReport;
         scQRBand:            SelectClass:=TQRBand;
         scQRGroup:           SelectClass:=TQRGroup;
         scQRDetailLink:      SelectClass:=TQRDetailLink;
         scQRLabel:           SelectClass:=TQRLabel;
         scQRMemo:            SelectClass:=TQRMemo;
         scQRDBText:          SelectClass:=TQRDBText;
         scQRDBCalc:          SelectClass:=TQRDBCalc;
         scQRSysData:         SelectClass:=TQRSysData;
         scQRShape:           SelectClass:=TQRShape;
         scQRPreview:         SelectClass:=TQRPreview;

        // Samples Page
         scIBEventAlerter:    SelectClass:=TIBEventAlerter;
         scGauge:             SelectClass:=TGauge;
         scColorGrid:         SelectClass:=TColorGrid;
         scSpinButton:        SelectClass:=TSpinButton;
         scSpinEdit:          SelectClass:=TSpinEdit;
         scDirectoryOutline:  SelectClass:=TDirectoryOutline;
         scCalendar:          SelectClass:=TCalendar;

    end;
    Result:=SelectClass;
    if not ShiftKeyed then  SelectedComponentIndex:=scNoComponent;
end;

// 泅犁 祈笼窍绊 乐绰 蜡聪飘客 楷搬等 汽阑 茫绰促.
function TFMainForm.GetLinkForm:TForm;
var
   I:Integer;
begin
   Result:=Screen.ActiveForm;
   for I:=0 to Screen.FormCount-1 do
      if Screen.Forms[I] is TProxyForm then
         if TProxyForm(Screen.Forms[I]).FileName = SelectUnit then begin
            Result:=Screen.Forms[I];
         end;
end;

procedure TFMainForm.ProxyFormShow(Sender: TObject);
begin
    ObjectInspector.GetPropertyInfo(ProxyDesigner.Form);
    ProxyDesigner.GetComponentList;
    ObjectInspector.ComponentList.Text:=ProxyDesigner.Form.Name+':TForm';
end;

procedure TFMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
var
   I,SaveResp:Integer;
begin
    if (ProjectInfo.ProjectState = psChange) then begin
       SaveResp := MessageDlg(Format('Save Change to %s?',
              [ExtractFileName(ProjectInfo.ProjectName)]), mtWarning, mbYesNoCancel, 0);
        if  SaveResp=idYes then   SaveProject(ProjectInfo.ProjectName)
        else if SaveResp=idCancel then Action:= caNone;
    end;
    SaveHistory(ProjectInfo.ProjectName);
end;

{哪欺惩飘 捞抚捞 蜡老茄瘤 抛胶飘 秦焊绊, 父老 蜡老窍促搁 True甫 府畔窍绊, 酒聪搁
 False甫 府畔茄促.}
function TFmainForm.TryName(const Test:string;Comp:TComponent):Boolean;
var
   I:Integer;
begin
    Result:=False;
    for I:=0 to Comp.ComponentCount-1 do
        if CompareText(Comp.Components[I].Name,Test) =0 then Exit;
    Result:=True;