mainfrm.pas

一个可以把源代码以语法高亮的形式转换成HTML格式或RTF格式。

        Memo.Lines.Add(Name + ' :---------------end----------------------'#13#10);
      finally
        GlobalUnlock(hData);
      end;
      
      uFormat := EnumClipboardFormats(uFormat);
    end;
  finally
    CloseClipboard ;
  end;

//GetClientRect(hwnd, &rc);
//DrawText(hdc, lpstr, -1, &rc, DT_LEFT);
//GlobalUnlock(hglb);

  // pcMain.TabIndex := 2;
  tsMemo.Show;
end;

procedure TFrmMain.mmgetClipboardFormatsClick(Sender: TObject);
begin
  getClipboardFormats;
end;

procedure TFrmMain.cbItemDblClick(Sender: TObject);
begin
  AddToMemo(cbItem.Items.Text); 
end;
{
procedure TFrmMain.gg1Click(Sender: TObject);
var
  A :OleVariant;
  s :string;
begin
  if WebBrowser.Document <> nil  then
  begin
    s := 'gb2312';
    IHTMLDocument2(WebBrowser.Document).charset := s;
    A := 7;
    WebBrowser.Refresh2(A); 
  end;  
end; }

procedure TFrmMain.RichEditKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
const 
  OnePage_Count = 20; 
var
  Qry : TAdoQuery;  
  Total_Count ,PageCount :Integer;
begin
  //Qry.SQL.Text :='';
 { Total_Count := 99 ;//Qry.Fields[0].Value;  // 总数
  PageCount := Trunc (Total_Count div OnePage_Count);
  if Total_Count mod OnePage_Count <>0 then
    Inc(PageCount);
  //=== PageCount := (Total_Count -1) div OnePage_Count +1
    
  ShowMessage(IntToStr(PageCount));
  
  Caption := Char(key);
  Key := 0;}
end;

procedure TFrmMain.btnTranClick(Sender: TObject);
var
  Count ,i:Integer;
  SrcPath,DesPath,AcciName :string;
  Strings :TStrings;
  v_Times :TTimer;
  //v_ProgressBar :TProgressBar;
  R :TRect;
  OldClick :TNotifyEvent;
begin
  if Not DirectoryExists(Trim(edtSrc.Text)) then
  begin
    ShowDlg('Src Dir Not Exists Error');
    edtSrc.SetFocus;
    Exit;
  end;
{  if Not DirectoryExists(Trim(edtDes.Text)) then
  begin
    ShowDlg('Des Dir Not Exists Error');
    edtDes.SetFocus;
    Exit;
  end;
         }
  i:=MessageBox(Handle,PChar(pubGet(124)),
    PChar(pubGet(2)),MB_YesNoCancel);
  if i=id_Cancel then Exit;
  {
  ConvertFilesToDir(Trim(edtSrc.Text),Trim(edtExt.Text),Trim(edtDes.Text),
    Trim(cbAcciType.Text),TConvType(cbConvType.ItemIndex),Count);
  lblMsg.Caption := pubGet(125)+ IntToStr(Count);
  }
  DesPath := Trim(edtDes.Text);
  SrcPath :=  Trim(edtSrc.Text);
  AcciName := Trim(cbAcciType.Text);
  fTranMoreFileMsg := pubGet(135);
  Strings := TStringList.Create;
  try
    fMoreFileProessCount :=0;
    v_Times := TTimer.Create(nil);
    try
      v_Times.Interval :=1000;
      v_Times.OnTimer := Self.TimerEvent;
      lblMsg.Hint := '';
      ProgressBar.Hint := '';
      v_Times.Enabled := True;
      OldClick := btnTran.OnClick ;
      btnTran.Caption := pubGet(7);
      btnTran.OnClick := lblMsg.OnClick ; // 指向能中止的过程
      Strings := GetDirFiles(Trim(edtSrc.Text),Trim(edtExt.Text));
      if gAppConfig.Terminate then
        Exit;
      Count := Strings.Count ;
      v_Times.Enabled := False;
      lblMsg.Hint := pubGet(125)+ IntToStr(Count);
      //v_ProgressBar := TProgressBar.Create(nil);
      try
        {R.Left := btnTran.Left;
        R.Top := btnTran.Top + btnTran.Height +5;
        R.Right := R.Left + edtDes.Width ;
        R.Bottom := R.Top + 16;
        
        v_ProgressBar.Parent := TabSheet1;
        v_ProgressBar.BoundsRect := R;
        v_ProgressBar.Max := Strings.Count ;
        v_ProgressBar.Min := 0;
        v_ProgressBar.Step := 1;  }
        ProgressBar.Max := Count ;
        ProgressBar.Step := 1;

        v_Times.Enabled := True;
        ConvertFiles(SrcPath,DesPath,AcciName,TConvType(cbConvType.ItemIndex),
          Strings,fMoreFileProessCount,
          fCurSrcFile,fCurDesFile,True,i=Id_Yes);          
        v_Times.Enabled := False;   
        lblMsg.Caption := pubGet(125)+ IntToStr(Count);
        if Not gAppConfig.Terminate then // 非终止
          ProgressBar.Position :=Count
        else  
          lblMsg.Caption := lblMsg.Caption + '  '+pubGet(8) + ' -- ' + 
            IntToStr(fMoreFileProessCount);
        ProgressBar.Hint := '';
        ProgressBar.Position :=0;
        lblCurSrc.Caption := '';
        lblCurDes.Caption := '';
      finally
        //v_ProgressBar.Free;
      end;
    finally
      btnTran.Caption := pubGet(119);
      btnTran.OnClick:= OldClick;
      v_Times.Free;
    end;
  finally
    Strings.Free;
  end;
  
end;


procedure TFrmMain.spSelectFileClick(Sender: TObject);
var
  i :Integer;
  sFileName :string;
begin
  i :=-1;
  sFileName := edtSrcFile.Text;
  if DMCommon.ExecOpenFile(pubGet('DialogFilter'),i,sFileName) then
    edtSrcFile.Text := sFileName;
end;

procedure TFrmMain.spSaveFileClick(Sender: TObject);
var
  i :Integer;
  sFileName :string;
begin
  sFileName := edtDesFile.Text;
  if cbConvType.ItemIndex =1 then // rtf
    i := 1
  else
    i := 2;       
  if DMCommon.ExecSaveFile(pubGet('DialogFilter'),i,sFileName) then
    edtDesFile.Text := sFileName;
end;

procedure TFrmMain.btnTranFileClick(Sender: TObject);
var
  i :integer;
  s ,sFileName,OutExt:string;
  Acc :TAccidence;  
begin
  if Not FileExists(Trim(edtSrcFile.Text)) then 
  begin
    MessageBox(Handle,PChar(pubGet('Info_SrcFileNoFound')),PChar(pubGet(2)),MB_OK);
    edtSrcFile.SetFocus;
    Exit;
  end;
  sFileName :=Trim(edtDesFile.Text);
  if sFileName='' then 
  begin
    MessageBox(Handle,PChar(pubGet('Info_SetDesFile')),PChar(pubGet(2)),MB_OK);
    edtDesFile.SetFocus;
    Exit;
  end;
  OutExt := LowerCase(ExtractFileExt(sFileName)); 
  if cbConvType.ItemIndex = 0 then // html
    if OutExt<> '.html' then OutExt := '.html'
  else if cbConvType.ItemIndex = 1 then
    if OutExt<> '.rtf' then OutExt := '.rtf'
  else
    OutExt := '';
  if OutExt <>'' then      
    sFileName :=ChangeFileExt(sFileName,OutExt);
   
  Acc := CreateAccidence;
  try
    Acc.ConversionToFile(Trim(edtSrcFile.Text),sFileName);
    s := Acc.Target.Text ;
    AddToMemo(s);
    AddToClipBoard(s,Acc.Source.Text); 
  finally
    Acc.Free;
  end;
  
  if Not chkTranView.Checked then       // 是否转换完后查看
    Exit;
  
  if Not FileExists(sFileName) then 
  begin
    MessageBox(Handle,PChar(pubGet(131)),PChar(pubGet(1)),MB_OK);
    edtDesFile.SetFocus;
    Exit; 
  end;  
  
  if cbConvType.ItemIndex =1 then // rtf
  begin
    RichEdit.Lines.LoadFromFile(sFileName);
    lblRichEditFileName.Caption := sFileName ;
    tsRichEdit.Show ;    
  end  
  else
  begin
    WebBrowser.Navigate(sFileName);
    lblWebBrowser.Caption := sFileName ;
    tsShowHtml.Show; 
  end;
end;

procedure TFrmMain.pmAboutClick(Sender: TObject);
begin
  CommonUtils.FormShowModal(TFrmAbout);  
end;

procedure TFrmMain.pnlAccSetClick(Sender: TObject);
var
  i :integer;
  s :string;
  arrS :Array of string;
  test :TAppXmlConfig;
  Str :TStrings;
begin
  inherited;
  //ShowDlg(pubGet(4));
  //if Pos('a','A')>0 then ShowDlg('Pos Case');
  
  if gAppConfig is TAppXmlConfig then
    test := gAppConfig as TAppXmlConfig
  else  
    test := TAppXmlConfig.Create(ExtractFilePath(ParamStr(0))+'config_2.xml'); 
  //test.AppendChildElement('myTag','fskafjsdk',nil);
  Str := TStringList.Create;
  try  
    test.GetSections(Str);
    //memo.lines.AddStrings (Str);
    AddToMemo(Str.Text); 
    //ShowMessage(test.GetValue('Sections','LangFile'));
    //test.SetValue('Sections','LangFile','abcdegfdask');
    //ShowMessage(test.GetValue('Sections','LangFile'));
    
    //test.SetValue('Sections','LangFile3','afda');
    //ShowMessage(test.GetValue('Sections','LangFile2'));
    if test.Modified then
    begin
      ShowDlg('Modified！ ChangCount:' + intToStr(test.ChangCount));
      //test.SaveAs(ExtractFilePath(ParamStr(0))+'config_2.xml'); 
    end
    else
      ShowDlg('No Modified！'); 
    Test.GetSection('AccidenceFiles',Str);
    Memo.Lines.AddStrings(Str);
    for i := 0 to Str.count -1 do
    begin
      Memo.Lines.Add(Str.Names[i]);
      Memo.Lines.Add(Str.ValueFromIndex[i]);      
    end;
    Memo.Lines.Add('');
    s := Test.GetAttrValue('Langs','Value','no');
    Memo.Lines.Add(s);
    //ShowDlg(s);
    s := Test.GetAttrValue('Shell','');
    Memo.Lines.Add(s);
    //ShowDlg(s);
    s := '';    
    for i:=32 to 127 do
      s := s + Chr(i);
    Memo.Lines.Add(s);
    Memo.Lines.Add(Test.GetAccidenceFiles) ;
    //Test.SetAttrValues('Sections','',['DataTime'],['2006-01-01']);
    
    //Test.SetAttrValues('Sections','DateTime',['DateTime'],['DateTime=2006-01-02'],True,True);
    ///setLength(ArrS,2);
    ///Arrs[0] := 'Id=1'#13#10'myName=liqj';
    ///ArrS[1] := 'Id=2'#13#10'myName=hll';
    //Test.SetAttrValues('Sections','',[],Arrs,True,True);
    //Test.SetAttrValues('Langs',[],[],True,True);
    ////Test.Save;//As(ExtractFilePath(ParamStr(0))+'config_2.xml'); 
  finally
    Str.Free;
    if gAppConfig is TAppXmlConfig then
      test :=nil
    else
      Test.Free;  
  end;
  tsMemo.Show ;  
end;


procedure TFrmMain.UpdateFileOpenAndSave(Sender: TObject);
begin
  inherited;
  TAction(Sender).Enabled :=GetCurFilterIndexActivePageOfName <>-1;
end;


procedure TFrmMain.TimerEvent(Sender: TObject);
var i :integer;
begin
  if fMoreFileProessCount >0 then
  begin    
    ProgressBar.Position :=fMoreFileProessCount;
    ProgressBar.Hint := IntToStr(fMoreFileProessCount);
    lblCurSrc.Caption := lblSrcFile.Caption + ':' +#13#10+ fCurSrcFile;
    lblCurDes.Caption := lblDesFile.Caption  + ':'+#13#10 + fCurDesFile;;
  end; 
  i :=(Sender as TTimer).Tag;
  if i>2 then
  begin
    lblMsg.Caption := lblMsg.Hint + '    ' + fTranMoreFileMsg + '...'+ProgressBar.Hint ;
    (Sender as TTimer).Tag := 1;
  end  
  else if i=2 then
  begin
    lblMsg.Caption := lblMsg.Hint + '    ' + fTranMoreFileMsg + '.. '+ProgressBar.Hint;
    (Sender as TTimer).Tag := 3;
  end   
  else if i<=1 then
  begin
    lblMsg.Caption := lblMsg.Hint + '    ' + fTranMoreFileMsg + '.  '+ProgressBar.Hint;
    (Sender as TTimer).Tag := 2;
  end;  
end;

procedure TFrmMain.lblMsgClick(Sender: TObject);
begin
  inherited;
  //
   // Application.Terminate 
  gAppConfig.Terminate := True;
 //Sleep(100000);
 // gAppConfig.Terminate := False; 
end;

initialization
  //OleInitialize(nil);

finalization
  //OleUninitialize;

end.