delphi4arab منتديات دلفي للعرب

الصفحات : 1 2 3 4 5 6

في القريب النسخة 5 Big Grin

تم اضافة اقرب المساجد
[صورة: VdFNqQI.jpg]

الخريطة

[indent]

زادك الله من واسع فضله ، و حفظك من كل سوء ومكروه.
[/indent]

الملف التنفيذي تجدونه في اول مشاركة
الطريقة المتبعة لايجاد اقرب مسجد

استدعاء الخريطة من الرسورس ( في المرفقات )
البحث عن المساجد في مجال منطقتك
حفظ النتيجة في input مخفي بعد معالجة البيانات و النتيجة النهائية من شكل json

PHP كود :
unit UnitMosque;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.OleCtrls, SHDocVw, Vcl.ComCtrls,
  sPageControl, sListView,var_and_const,ActiveX,MSHTML,Vcl.SuperObject,
  sStatusBar,unit1 ;

type
  TForm17 = class(TForm)
    sPageControl1: TsPageControl;
    sTabSheet1: TsTabSheet;
    sTabSheet2: TsTabSheet;
    WebBrowser1: TWebBrowser;
    sListView1: TsListView;
    sStatusBar1: TsStatusBar;
    procedure FormCreate(Sender: TObject);
    procedure sTabSheet2Show(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure WebBrowser1DownloadComplete(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form17: TForm17;

implementation
   procedure WBLoadHTML(WebBrowser: TWebBrowser; HTMLCode: string) ;
var
   sl: TStringList;
   ms: TMemoryStream;
begin
   WebBrowser.Navigate('about:blank') ;
   while WebBrowser.ReadyState <READYSTATE_INTERACTIVE do Application.ProcessMessages;

   if Assigned(WebBrowser.Document) then
   begin
     sl := TStringList.Create;
     try
       ms := TMemoryStream.Create;
       try
         sl.Text := HTMLCode;
         sl.SaveToStream(ms) ;
         ms.Seek(0, 0) ;
         (WebBrowser.Document as IPersistStreamInit).Load(TStreamAdapter.Create(ms)) ;
       finally
         ms.Free;
       end;
     finally
       sl.Free;
     end;
   end;
end;
{$R *.dfm}

procedure TForm17.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action:=caFree ;
WFreeMemory;
end;

procedure TForm17.FormCreate(Sender: TObject);
var
MyStream:TResourceStream;
str:TStringList;
sHTML:string;
begin

str:=TStringList.Create;
MyStream:= TResourceStream.Create(hinstance, 'MAP', RT_RCDATA);

try
str.LoadFromStream(MyStream);
sHTML := str.Text;
finally
 MyStream.Free;
 str.Free;
end;


  sHTML:=StringReplace(sHTML,'[Lat]',StringReplace(FloatToStr(latitude),',','.',[rfReplaceAll]),[rfReplaceAll]) ;
  sHTML:=StringReplace(sHTML,'[Lng]',StringReplace(FloatToStr(longitude),',','.',[rfReplaceAll]),[rfReplaceAll]) ;
  WBLoadHTML(WebBrowser1,sHTML) ;
end;

procedure TForm17.sTabSheet2Show(Sender: TObject);
var
  ADocument : IHTMLDocument2;
  ABody     : IHTMLElement2;
  json : string;
  i,count: Word;
  Super: ISuperObject;

      function GetIdValue(const Id : string):string;
      var
        Tag      : IHTMLElement;
        TagsList : IHTMLElementCollection;
        Index    : Integer;
      begin
        Result:='';
        TagsList := ABody.getElementsByTagName('input');
        for Index := 0 to TagsList.length-1 do
        begin
          Tag:=TagsList.item(Index, EmptyParam) As IHTMLElement;
          if CompareText(Tag.id,Id)=0 then
            Result := Tag.getAttribute('value', 0);
        end;
      end;

begin
  ADocument := WebBrowser1.Document as IHTMLDocument2;
  if not Assigned(ADocument) then
    Exit;
  if not Supports(ADocument.body, IHTMLElement2, ABody) then
    exit;

 json :=GetIdValue('side_bar');
 if Length(json)=0 then Exit;
 Super := SO(json);
 if Super = nil then Exit;
 sListView1.Clear;
 try

      if Assigned(Super['places'].AsArray) then
      Count :=Super['places'].AsArray.Length;

     for i := 0 to Count - 1 do
          with sListView1.Items.Add do
          begin
            Caption :=IntToStr(i+1);
            subitems.Add(Super['places[' + inttostr(i) + '].name'].AsString);
            subitems.Add(Super['places[' + inttostr(i) + '].distance'].AsString);
            subitems.Add(Super['places[' + inttostr(i) + '].vicinity'].AsString);
            ImageIndex:=12;
          end;
          except  on e:exception do
           sstatusbar1.Panels[0].Text:='حدث خطأ '+e.Message;
          end;
      if slistview1.Items.Count>0 then
      sstatusbar1.Panels[0].Text:='اقرب مسجد : ' + slistview1.Items[0].SubItems[0] +' عن بعد : '  +slistview1.Items[0].SubItems[1]+ ' متر'
end;

procedure TForm17.WebBrowser1DownloadComplete(Sender: TObject);
begin
//sTabSheet2.TabVisible:=True;
end;

end. 

السلام عليكم
ما هي نسحة الدلفي المستعملة في السورس
لأني أجد صعوبة في قراءة السورس كاملا
جزاكم الله خيرا

الصفحات : 1 2 3 4 5 6

onexite

أبو معاذ

onexite

nourim