mainform.pas

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

end;

{钎霖 胆颇捞狼 盔蘑阑 荤侩窍咯 哪欺惩飘俊 措茄 蜡老茄 捞抚阑 积己茄促. 溜 <鸥涝><箭磊>
 屈侥阑 荤侩窍绰单, <鸥涝>篮 哪欺惩飘狼 努贰胶 捞抚俊辑 'T'甫 猾 巴捞绊, <箭磊>绰
 捞抚阑 窜老窍霸 父甸扁 困茄 沥荐捞促.}
function TFMainForm.UniqueName(Comp:TComponent):string;
var
   I:Integer;
   Fmt:string;
begin
    if Comp.ClassName[1] in ['t','T'] then
        Fmt:=Copy(Comp.ClassName,2,255)+'%d'
    else Fmt:=Comp.ClassName+'%d';
    if Comp.Owner=nil then begin
       {家蜡磊啊 绝栏骨肺 葛电 捞抚捞 悼老窍促. 1阑 荤侩茄促.}
       Result:=Format(Fmt,[1]);
       Exit;
    end
    else begin
       {蜡老茄 捞抚捞 唱棵 锭鳖瘤 , 啊瓷茄 箭磊甫 葛滴 矫氰茄促.}
       for I:=1 to High(Integer) do begin
           Result:=Format(Fmt,[I]);
           if TryName(Result,Comp.Owner) then Exit;
       end;
    end;
end;

// FormName俊 楷搬等 蜡聪飘 捞抚阑 炼荤茄促.
function TFMainForm.GetUnitName(const FormName:string):string;
var
  I:Integer;
begin
    Result:='';
    for I:=0 to ProjectInfo.FormItems.Count-1 do begin
       if Pos(FormName,ProjectInfo.FormItems[I])>0 then begin
          Result:= ProjectInfo.UnitItems[I];
          Exit;
       end;
    end;
end;

procedure TFMainForm.ProjectAddItemClick(Sender: TObject);
begin
    OpenDialog1.FileName:='';
    OpenDialog1.FilterIndex:=3;
    if OpenDialog1.Execute then begin
       ProjectInfo.UnitItems.Add(GetNetFileName(OpenDialog1.FileName));
       ProjectInfo.FormItems.Add('Test');
       InsertProjectCode(GetNetFileName(OpenDialog1.FileName),'Test');
    end;
end;

procedure TFMainForm.ProjectRemoveItemClick(Sender: TObject);
begin
    CreateShowModal(TRemoveProject);
end;

// 泅犁狼 橇肺璃飘甫 ini History俊 历厘茄促.
procedure TFMainForm.SaveHistory(const Project:string);
var
   LastNum,I:Integer;
   List:TStringList;
begin
   List:=TStringList.Create;
   IniFile.ReadSectionValues('ProjectHistory',List);
   for I:=0 to List.Count-1 do
       if List.Values[IntToStr(I)]=Project then begin
          List.Free;
          Exit;
       end;
   LastNum:=IniFile.ReadInteger('ProjectHistory','Last',0);
   if LastNum<15 then  begin
      IniFile.WriteInteger('ProjectHistory','Last',LastNum+1);
      IniFile.WriteString('ProjectHistory',IntToStr(LastNum+1),Project);
   end
   else  IniFile.WriteInteger('ProjectHistory','Last',0);
end;

// 傈俊 佬菌带 橇肺璃飘客 蜡聪飘甫 皋春俊 眠啊茄促.
procedure TFMainForm.OpenHistory;
var
   I:Integer;
   NewMenuItem:TMenuItem;
   List:TStringList;
begin
   List:=TStringList.Create;
   IniFile.ReadSectionValues('ProjectHistory',List);
   for I:=0 to List.Count-1 do begin
      if FileExists(List.Values[IntToStr(I)]) then begin
         NewMenuItem:=TMenuItem.Create(Self);
         NewMenuItem.Caption:=List.Values[IntToStr(I)];
         NewMenuItem.OnClick:= OpenHistoryFile;
         ReOpen1.Add(NewMenuItem);
      end;
   end;
   List.Free;
end;

// 傈俊 佬菌带 橇肺璃飘甫 角青茄促.(促矫 凯扁 皋春俊辑 急琶窍绰 版快)
procedure TFMainForm.OpenHistoryFile(Sender: TObject);
begin
   if ExtractFileExt((Sender as TMenuItem).Caption)='.dpr' then
      OpenProject((Sender as TMenuItem).Caption)
   else OpenFile((Sender as TMenuItem).Caption);
end;

// 汽苞 蜡聪飘 荤捞甫 傈券茄促.
procedure TFMainForm.ToggleFormAndUnit;
var
  I:Integer;
  FileName:string;
begin
   if ToggleFormUnit then begin
      for I:=0 to Screen.FormCount - 1 do
         if Screen.Forms[I] is TProxyForm then begin
            FileName:= ExtractFileName(TProxyForm(Screen.Forms[I]).FileName);
            if FileName  = EditorForm.Caption then
               Screen.Forms[I].SetFocus;
         end;
   end
   else EditorForm.SetFocus;
   ToggleFormUnit:= not ToggleFormUnit;
end;

procedure TFMainForm.ExecuteTool(Sender: TObject);
var
  ExeName:string;
begin
   ExeName:=IniFile.ReadString('Tools',(Sender as TMenuItem).Caption,'');
   WinExec(PChar(ExeName),SW_SHOWNORMAL);
end;

procedure TFMainForm.OpenTools;
var
   I:Integer;
   NewMenuItem:TMenuItem;
   List:TStringList;
begin
   List:=TStringList.Create;
   IniFile.ReadSection('Tools',List);
   for I:=0 to List.Count-1 do begin
         NewMenuItem:=TMenuItem.Create(Self);
         NewMenuItem.Caption:=List[I];
         NewMenuItem.OnClick:= ExecuteTool;
         ToolsMenu.Add(NewMenuItem);
   end;
   List.Free;
end;

procedure TFMainForm.ViewWindowListItemClick(Sender: TObject);
begin
    CreateShowModal(TWindowList);
end;

procedure TFMainForm.ViewCompListItemClick(Sender: TObject);
begin
    CreateShowModal(TComponentList);
end;

procedure TFMainForm.ToolsToolsItemClick(Sender: TObject);
begin
   CreateShowModal(TTools);
end;

procedure TFMainForm.UpdateControl;
begin

end;

// 目辑 困摹俊 乐绰 窜绢甫 舅妨霖促.
function TFMainForm.GetCursorWord:string;
var
  WordText:string;
  I,LineLength,LinePos:Integer;
  CurPos,StartPos,EndPos:Integer;
begin
  Result:='';
  LinePos:= SendMessage(ActiveRichEdit.Handle,EM_LINEFROMCHAR,-1,0);
  WordText:= ActiveRichEdit.Lines[LinePos]; // 目辑 困摹俊 乐绰 青狼 巩磊凯
  if Length(WordText)<1 then Exit;
  LinePos:= SendMessage(ActiveRichEdit.Handle,EM_LINEINDEX,-1,0);
  CurPos:=ActiveRichEdit.SelStart-LinePos+1;
  LineLength:= SendMessage(ActiveRichEdit.Handle,EM_LINELENGTH,ActiveRichEdit.SelStart,0);
  for I:= CurPos downto 1 do begin
      if (WordText[I] ='')  then Exit;
      if WordText[I] in [' ',#0..#47,#58..#64,#91..#96,#123..#127] then Break;
  end;
  StartPos:= I+1;  // 窜绢狼 矫累 困摹
  for I:= CurPos to LineLength do begin
      if WordText[I] ='' then Exit;
      if WordText[I] in [' ',#0..#47,#58..#64,#91..#96,#123..#127] then Break;
  end;
  EndPos:= I;  // 窜绢狼 付瘤阜 困摹
  WordText:= Trim(Copy(WordText,StartPos, EndPos-StartPos));
  Result:= WordText;
end;

// 巩磊凯阑 八祸茄促.
function TFMainForm.SearchingText(SearchStr:string;Options:TYB_SearchType):Boolean;
var
   FindOption:TSearchTypes;
   StartPos,LinePos,TempPos,CaretPos:integer;
   CharRange:TCharRange;
begin
    Result:= True;
    StartPos:= SendMessage(ActiveRichEdit.Handle, EM_LINEINDEX, -1,0);
    CaretPos:=ActiveRichEdit.SelStart-StartPos+1;
    if Options.Direction = fdDown then
       StartPos:= StartPos+CaretPos+1
    else
       StartPos:= StartPos+CaretPos+1;
    if Options.Scope = fsSelected then begin  // 急琶茄 康开俊辑父 八祸窍绰 版快
       SendMessage(ActiveRichEdit.Handle, EM_EXGETSEL, 0, Longint(@CharRange));
       CharRange.cpMax:=SendMessage(ActiveRichEdit.Handle, EM_FINDWORDBREAK,
                     WB_MOVEWORDRIGHT, CharRange.cpMin);
       SendMessage(ActiveRichEdit.Handle, EM_EXSETSEL, 0, Longint(@CharRange));
       MatchPos:=ActiveRichEdit.FindText(SearchStr,CharRange.cpMin,CharRange.cpMax,Options.FindOption)
    end
    else if Options.Origin = foCursor then  // 某返 困摹俊辑何磐 八祸阑 矫累窍绰 版快
       if Options.Direction = fdDown then   // 酒贰 规氢栏肺 八祸窍绰 版快
          MatchPos:=ActiveRichEdit.FindText(SearchStr,StartPos,ActiveRichEdit.GetTextLen,Options.FindOption)
       else begin
          TempPos:=0;
          while True do begin
             TempPos:=ActiveRichEdit.FindText(SearchStr,TempPos,StartPos,Options.FindOption);
             if TempPos <>-1 then MatchPos:= TempPos
             else Break;
             TempPos:= TempPos+2;
          end;
       end
    else
       MatchPos:=ActiveRichEdit.FindText(SearchStr,0,ActiveRichEdit.GetTextlen,Options.FindOption);
    if MatchPos<>-1 then begin // 巩磊凯 八祸俊 己傍茄 版快
        ActiveRichEdit.SetFocus;
        ActiveRichEdit.SelStart:=MatchPos;
        ActiveRichEdit.SelLength := Length(SearchStr);
    end
    else begin
         MsgDlg('"'+SearchStr+'"'+' finished finding.',Application.Title,mb_OK);
         EndPos:=0;
         ActiveRichEdit.SetFocus;
         Result:= False;
    end;
end;

procedure TFMainForm.SearchFinfInFilesItemClick(Sender: TObject);
begin
   CreateShowModal(TFindInFile);
end;

// 巩磊凯阑 促弗 巩磊凯肺 官槽促.
procedure TFMainForm.ReplacingText(FindText,ReplaceText:string;Options:TYB_SearchType);
var
  ret:Integer;
begin
   if (Options.ReplaceAll ) then begin // 葛滴 官操扁甫 急琶茄 版快
       while True do begin
           if not SearchingText(FindText,Options) then Exit;
           if (Options.PromptOn) and (ret<>mrAll) then begin  // 官操扁矫 犬牢 例瞒甫 芭媚具 窍绰 版快
              ret:=MessageDlg('Replace '+FindText+'to '+ReplaceText+'?',
                      mtConfirmation,[mbYes,mbNo,mbCancel,mbAll],0);
              if (ret = mrYES) or (ret=mrAll) then
                 SendMessage(ActiveRichEdit.Handle, EM_REPLACESEL, 0,Longint(PChar(ReplaceText)))
              else if ret = mrCancel then Exit;
           end
           else
              SendMessage(ActiveRichEdit.Handle, EM_REPLACESEL, 0,Longint(PChar(ReplaceText)));
       end;
   end
   else if SearchingText(FindText,Options) then
      SendMessage(ActiveRichEdit.Handle, EM_REPLACESEL, 0,Longint(PChar(ReplaceText)));
end;

// 汽 颇老俊 乐绰 哪欺惩飘狼 努贰胶甫 殿废茄促.
procedure TFMainForm.ReadClass;
begin
    RegisterClass(TForm);
    while True do
    begin
        Inc(ParseLine);
        if ParseLine>=SourceList.Count then Break ;
        if Pos('TButton',SourceList[ParseLine])>0 then                RegisterClass(TButton)
        else if Pos('TMainMenu',SourceList[ParseLine])>0 then         RegisterClass(TMainMenu)
        else if Pos('TPopupMenu',SourceList[ParseLine])>0 then        RegisterClass(TPopupMenu)
        else if Pos('TLabel',SourceList[ParseLine])>0 then            RegisterClass(TLabel)
        else if Pos('TEdit',SourceList[ParseLine])>0 then             RegisterClass(TEdit)
        else if Pos('TEdit',SourceList[ParseLine])>0 then             RegisterClass(TEdit)
        else if Pos('TMemo',SourceList[ParseLine])>0 then             RegisterClass(TMemo)
        else if Pos('TRadioButton',SourceList[ParseLine])>0 then      RegisterClass(TRadioButton)
        else if Pos('TCheckBox',SourceList[ParseLine])>0 then         RegisterClass(TCheckBox)
        else if Pos('TListBox',SourceList[ParseLine])>0 then          RegisterClass(TListBox)
        else if Pos('TComboBox',SourceList[ParseLine])>0 then         RegisterClass(TComboBox)
        else if Pos('TScrollBar',SourceList[ParseLine])>0 then        RegisterClass(TScrollBar)
        else if Pos('TGroupBox',SourceList[ParseLine])>0 then         RegisterClass(TGroupBox)
        else if Pos('TRadioGroup',SourceList[ParseLine])>0 then       RegisterClass(TRadioGroup)
        else if Pos('TPanel',SourceList[ParseLine])>0 then            RegisterClass(TPanel)

        else if Pos('TBitBtn',SourceList[ParseLine])>0 then           RegisterClass(TBitBtn)
        else if Pos('TSpeedButton',SourceList[ParseLine])>0 then      RegisterClass(TSpeedButton)
        else if Pos('TMaskEdit',SourceList[ParseLine])>0 then         RegisterClass(TMaskEdit)
        else if Pos('TStringGrid',SourceList[ParseLine])>0 then       RegisterClass(TStringGrid)
        else if Pos('TImage',SourceList[ParseLine])>0 then            RegisterClass(TImage)
        else if Pos('TShape',SourceList[ParseLine])>0 then            RegisterClass(TShape)
        else if Pos('TBevel',SourceList[ParseLine])>0 then            RegisterClass(TBevel)
        else if Pos('TScrollBox',SourceList[ParseLine])>0 then        RegisterClass(TScrollBox)

        else if Pos('TTabControl',SourceList[ParseLine])>0 then       RegisterClass(TTabControl)
        else if Pos('TPageControl',SourceList[ParseLine])>0 then      RegisterClass(TPageControl)
        else if Pos('TTreeView',SourceList[ParseLine])>0 then         RegisterClass(TTreeView)
        else if Pos('TListView',SourceList[ParseLine])>0 then         RegisterClass(TListView)
        else if Pos('TImageList',SourceList[ParseLine])>0 then        RegisterClass(TImageList)
        else if Pos('THeaderControl',SourceList[ParseLine])>0 then    RegisterClass(THeaderControl)
        else if Pos('TRichEdit',SourceList[ParseLine])>0 then         RegisterClass(TRichEdit)
        else if Pos('TStatusBar',SourceList[ParseLine])>0 then        RegisterClass(TStatusBar)
        else if Pos('TTrackBar',SourceList[ParseLine])>0 then         RegisterClass(TTrackBar)
        else if Pos('TProgressBar',SourceList[ParseLine])>0 then      RegisterClass(TProgressBar)
        else if Pos('TUpDown',SourceList[ParseLine])>0 then           RegisterClass(TUpDown)
        else if Pos('THotKey',SourceList[ParseLine])>0 then           RegisterClass(THotKey)

        else if Pos('TTable',SourceList[ParseLine])>0 then            RegisterClass(TTable)
        else if Pos('TQuery',SourceList[ParseLine])>0 then            RegisterClass(TQuery)
        else if Pos('TDataSource',SourceList[ParseLine])>0 then       RegisterClass(TDataSource)
        else if Pos('TStoredProc',SourceList[ParseLine])>0 then       RegisterClass(TStoredProc)
        else if Pos('TDatabase',SourceList[ParseLine])>0 then         RegisterClass(TDatabase)
        else if Pos('TSession',SourceList[ParseLine])>0 then          RegisterClass(TSession)
        else if Pos('TBatchMove',SourceList[ParseLine])>0 then        RegisterClass(TBatchMove)
        else if Pos('TUpdateSQL',SourceList[ParseLine])>0 then        RegisterClass(TUpdateSQL)

        else if Pos('TDBGrid',SourceList[ParseLine])>0 then           RegisterClass(TDBGrid)
        else if Pos('TDBNavigator',SourceList[ParseLine])>0 then      RegisterClass(TDBNavigator)
        else if Pos('TDBText',SourceList[ParseLine])>0 then           RegisterClass(TDBText)
        else if Pos('TDBEdit',SourceList[ParseLine])>0 then           RegisterClass(TDBEdit)
        else if Pos('TDBMemo',SourceList[ParseLine])>0 then           RegisterClass(TDBMemo)
        else if Pos('TDBImage',SourceList[ParseLine])>0 then          RegisterClass(TDBImage)
        else if Pos('TDBListBox',SourceList[ParseLine])>0 then        RegisterClass(TDBListBox)
        else if Pos('TDBComboBox',SourceList[ParseLine])>0 then       RegisterClass(TDBComboBox)
        else if Pos('TDBCheckBox',SourceList[ParseLine])>0 then       RegisterClass(TDBCheckBox)
        else if Pos('TDBRadioGroup',SourceList[ParseLine])>0 then     RegisterClass(TDBRadioGroup)
        else if Pos('TDBLookupListBox',SourceList[ParseLine])>0 then  RegisterClass(TDBLookupListBox)
        else if Pos('TDBLookupComboBox',SourceList[ParseLine])>0 then RegisterClass(TDBLookupComboBox)
        else if Pos('TDBCtrlGrid',SourceList[ParseLine])>0 then       RegisterClass(TDBCtrlGrid)

        else if Pos('TTimer',SourceList[ParseLine])>0 then            RegisterClass(TTimer)
        else if Pos('TPaintBox',SourceList[ParseLine])>0 then         RegisterClass(TPaintBox)
        else if Pos('TFileListBox',SourceList[ParseLine])>0 then      RegisterClass(TFileListBox)
        else if Pos('TDirectoryListBox',SourceList[ParseLine])>0 then RegisterClass(TDirectoryListBox)
        else if Pos('TDriveComboBox',SourceList[ParseLine])>0 then    RegisterClass(TDriveComboBox)
        else if Pos('TFilterComboBox',SourceList[ParseLine])>0 then   RegisterClass(TFilterComboBox)
        else if Pos('TMediaPlayer',SourceList[ParseLine])>0 then      RegisterClass(TMediaPlayer)

        else if Pos('TIBEventAlerter',SourceList[ParseLine])>0 then   RegisterClass(TIBEventAlerter)
        else if Pos('TGauge',SourceList[ParseLine])>0 then            RegisterCl