Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Работа с сетью в Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 12.11.2012, 20:51   #1
s2004
Пользователь
 
Регистрация: 30.11.2011
Сообщений: 13
Восклицание embeddedwb не отражает русский шрифт

Код:
procedure TForm1.AddUrl1Click(Sender: TObject);
begin
Caption := AddToFavorites(IEAddress1.Text, '', 'Delphi');
end;
unit DlgAddToFavourites; 
  public
    function Execute(AUrl: string; AName: string = ''; AFolder: string = ''): Boolean;
    property FovouritesFolder: string read GetFavourites;
    constructor Create(AOwner: TComponent); override;
  published
    property URL: string read GetUrl write SetUrl;
    property UName: string read GetUName write SetUName;
    property Folder: string read GetFolder write SetFolder;
    property FileName: string read fFileName write fFileName;
  end;
 function AddToFavorites(AUrl, AName, AFolder: string): string;
 implementation
 {$R *.dfm}
 { TfAddToFavorites }
 constructor TfAddToFavorites.Create(AOwner: TComponent);
begin
  inherited;
  RescanFolders;
end;
 function TfAddToFavorites.Execute(AUrl, AName, AFolder: string): Boolean;
begin
  UName := AName;
  Url := AUrl;
  if AFolder <> '' then
    AFolder := ExtractFileName(GetFavourites) + '\' + AFolder;
  cbFolder.ItemIndex := cbFolder.Items.IndexOf(AFolder);
  if (cbFolder.ItemIndex = -1) then cbFolder.ItemIndex := 0;
  Result := ShowModal = mrOk;
end;
 
function TfAddToFavorites.GetFavourites: string;
var s:  string;
begin
  SetLength(s, MAX_PATH);
  if not SHGetSpecialFolderPath(0, PChar(s), CSIDL_FAVORITES, true)
  then s := '';
  result := PChar(s);
end;
 
function TfAddToFavorites.GetFolder: string;
begin
  Result := cbFolder.Text;
end;
 
function TfAddToFavorites.GetUName: string;
begin
  Result := eName.Text;
end;
 function TfAddToFavorites.GetUrl: string;
begin
  Result := eUrl.Text;
end;
 
procedure ScanFolder(path: string; sl: TStrings; pref: string);
var
  sr: TSearchRec;
begin
  path := path + '\';
  if FindFirst(path + '*.*', faDirectory, sr) = 0 then
  begin
    repeat
      if ((sr.Attr and faDirectory) = faDirectory) then
      if (sr.Name <> '.') and (sr.Name <> '..') then
      begin
        sl.Add(pref + sr.Name);
        ScanFolder(path + sr.Name, sl, pref + '\' + sr.Name);
      end;
    until FindNext(sr) <> 0;
    FindClose(sr);
  end;
end;
 
procedure TfAddToFavorites.RescanFolders;
var
  sl: TStrings;
  p:  string;
begin
  p := GetFavourites;
  sl := cbFolder.Items;
  sl.Add(ExtractFileName(p));
  ScanFolder(p, sl, ExtractFileName(p) + '\');
end;
 
procedure TfAddToFavorites.SetFolder(const Value: string);
begin
  cbFolder.Text := Value;
end;
 
procedure TfAddToFavorites.SetUName(const Value: string);
begin
  eName.Text := Value;
end;
procedure TfAddToFavorites.SetUrl(const Value: string);
begin
  eUrl.Text := Value;
end;
function AddToFavorites(AUrl, AName, AFolder: string): string;
var f: TfAddToFavorites;
begin
  Application.CreateForm(TfAddToFavorites, f);
  if f.Execute(AUrl, AName, AFolder) then Result := f.FileName
  else Result := '';
  f.Free;
end;
procedure TfAddToFavorites.cbFolderDrawItem(Control: TWinControl;
  Index: Integer; r: TRect; State: TOwnerDrawState);
var
  i,o,l,d: integer;
  s,n: string;
  cb: TComboBox;
begin
  cb := TComboBox(Control);
  s := cb.Items[Index];
  n := ExtractFileName(s);
  o := 0;
  for i := 1 to Length(s) do if s[i] = '\' then Inc(o);
  with cb.Canvas do
  begin
    if odHotLight    in State then cb.Brush.Color := clHighlight
    else cb.Brush.Color := clWindow;
    cb.Canvas.FillRect(Rect(0, r.Top, cb.Width, r.Bottom));
    l := r.Left + o * 10; d := r.Top + (r.Bottom - r.Top) div 2;
    Polyline([Point(l-1, d), Point(l-5, d), Point(l-5, r.Top), Point(l-5, r.Bottom)]);
    cb.Canvas.TextOut(l, r.Top, n);
  end;
end;
procedure TfAddToFavorites.bOkClick(Sender: TObject);
var
  f: string;
  sl: TStringList;
begin
  f := ExtractFilePath(GetFavourites) + Folder;
  ForceDirectories(f);
  sl := TStringList.Create;
  sl.Add('[InternetShortcut]');
  sl.Add('URL=' + url);
  f := f + '\' + UName + '.url';
  try
    sl.SaveToFile(f);
  finally
    sl.Free;
  end;
  Close;
end;
procedure TfAddToFavorites.BitBtn1Click(Sender: TObject);
var
  f: TForm;
  e: TEdit;
  b: TBitBtn;
  s: string;
begin
  f := TForm.Create(nil);
  f.Width := 300;
  f.Caption := 'Add New Folder';
  f.Position := poScreenCenter;
  e := TEdit.Create(f);
  e.Parent := f;
  f.ClientHeight := e.Height;
  e.Align := alTop;
  b := TBitBtn.Create(f);
  b.Top := e.BoundsRect.Bottom + 4;
  b.Left := 8;
  b.Parent := f;
  b.Kind := bkOK;
  b := TBitBtn.Create(f);
  b.Top := e.BoundsRect.Bottom + 4;
  b.Parent := f;
  b.Kind := bkCancel;
  b.Left := f.ClientWidth - b.Width - 8;
  b.Anchors := [akTop, akRight];
  f.ClientHeight := b.BoundsRect.Bottom + 4;
  if f.ShowModal = mrOk then
  begin
    if e.Text = '' then Exit;
    s := cbFolder.Text + '\' + e.Text;
    cbFolder.Items.Insert(cbFolder.ItemIndex + 1, s);
    cbFolder.ItemIndex := cbFolder.ItemIndex + 1;
  end;
end;
end.
s2004 вне форума Ответить с цитированием
Старый 13.11.2012, 05:54   #2
BARNEY
Участник клуба
 
Регистрация: 23.04.2009
Сообщений: 1,058
По умолчанию

попробуй использовать AnsiString и AnsiChar
Если вам человек помог, не стесняйтесь говорить спасибо (весы под аватаром)
BARNEY вне форума Ответить с цитированием
Старый 13.11.2012, 22:02   #3
s2004
Пользователь
 
Регистрация: 30.11.2011
Сообщений: 13
По умолчанию

Цитата:
Сообщение от BARNEY Посмотреть сообщение
попробуй использовать AnsiString и AnsiChar
а подробней
s2004 вне форума Ответить с цитированием
Старый 26.11.2012, 04:37   #4
-=Virus=-
Форумчанин
 
Аватар для -=Virus=-
 
Регистрация: 03.07.2009
Сообщений: 246
По умолчанию

Цитата:
Сообщение от s2004 Посмотреть сообщение
а подробней
Код:
var
s,a:string;
begin
 //s - текст который нужно преобразовать в русский
 //a - тут преобразованный текст в русский
 a:=AnsiToUtf8(s);
 showmessage(a);
end;
или

Код:
var
s,a:string;
begin
 //s - текст который нужно преобразовать в русский
 //a - тут преобразованный текст в русский
 a:=AnsiString(s);
 showmessage(a);
end;
что то типа такого.
-=Virus=- вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Не отображается русский шрифт about_pooh БД в Delphi 11 10.04.2012 16:36
Как добавить в Дельфи русский шрифт? Gandfil Общие вопросы Delphi 12 18.09.2011 02:48
Русский шрифт в OpenGL (делфи 2010) marina15056 Софт 1 14.04.2011 05:48
Число в текст (русский шрифт) Елена5 Microsoft Office Excel 1 25.11.2010 22:51
Как настроить в Radasm русский шрифт gigos Assembler - Ассемблер (FASM, MASM, WASM, NASM, GoASM, Gas, RosAsm, HLA) и не рекомендуем TASM 2 19.05.2010 02:32