Konuyu Paylaş : facebook gplus twitter

Konuyu Oyla:
  • Derecelendirme: 0/5 - 0 oy
  • 1
  • 2
  • 3
  • 4
  • 5
Harita programı yazdırılacaktır.
#1
Merhaba arkadaşlar basit bir harita programı yazdırılacak örnek olarak programı indirip bakabilirsiniz program fiyatını özel mesaj ile gönderirseniz sevinirim.

Yada benim kullandığım program'da harita üzerinde nesne göstermeyi yapamadım nesne göstermeyi yaparsanız program yazmaya gerek kalmaz bunu yaparsanız fiyat ne olur özel mesaj atarsanız sevinirim.

Linkleri Görebilmeniz İçin Giriş yap veya Üye Ol

Program özellikleri,

Kod:
1- yakınlaştırma ve uzaklaştırma.
2- mause ile aşşağı yukarı sağa sola götürme.
3- harita üzerinde belirli kordinata nesne koyma.

uoam.jpg
Uoam02.jpg
Detay olarak program'ı yukardan indirip bakabilirsiniz.
Cevapla
#2
Lightbulb 
Daha önce gönderdiğim örneği istediğin şekle göre modifiye edip konsept bir proje hazırladım. İncelediğinde ne kadar basit olduğunu göreceksin.

Linkleri Görebilmeniz İçin Giriş yap veya Üye Ol

Kaynak Kodu
Var
 xBitmap : TBitmap;
 xSonX, xSonY : Integer;
 boolDown : Boolean = False;

procedure TForm1.btTemizleClick(Sender: TObject);
begin
 Image1.Picture.Graphic := xBitmap;
end;

procedure TForm1.ekilEkle1Click(Sender: TObject);
Var
 x1, y1 : Integer;
begin
 x1 := Trunc( xSonX / (Image1.Width  / Image1.Picture.Bitmap.Width ) );
 y1 := Trunc( xSonY / (Image1.Height / Image1.Picture.Bitmap.Height) );
 ListBox1.Items.Add( Format('%.3d,%.3d@%.2d', [ X1, Y1, Image2.Tag ]) );
 FormResize(Nil);
end;

procedure TForm1.btDoldurClick(Sender: TObject);
Var
 i : Integer;
 x, y : Integer;
 imageIdx: Integer;
 Satir : String;
 x1, y1 : Integer;
begin
 for i := 0 to ListBox1.Count - 1 do begin
   Satir := ListBox1.Items[i];
   x := StrToInt( Copy(Satir, 1, Pos(',', Satir) -1) );
   System.Delete(Satir, 1, Pos(',', Satir));
   y := StrToInt( Copy(Satir, 1, Pos('@', Satir) -1) );
   System.Delete(Satir, 1, Pos('@', Satir));
   imageIdx :=StrToInt(Trim(Satir));

   x1 := Trunc( X * (Image1.Width  / Image1.Picture.Bitmap.Width ) ) - 19;
   y1 := Trunc( Y * (Image1.Height / Image1.Picture.Bitmap.Height) ) - 19;

   ImageList1.Draw( PaintBox1.Canvas, x1-5, y1-5, ImageIdx);
   //with PaintBox1.Canvas do begin
     //Brush.Style := bsSolid;
     //Brush.Color := clYellow;
     //Pen.Color   := clBlue;
     //Pen.Width   := 3;
     //Rectangle(x1-5, y1-5, x1+5, y1+5);
   //end;
 end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 ListBox1.Items.SaveToFile( ChangeFileExt(Application.Exename, '_Koordinat.TXT') );
 xBitmap.Free;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 PaintBox1.Width  := Image1.Width;
 PaintBox1.Height := Image1.Height;
 ScrollBox1.OnScrollVert := MyScrollVert;
 ScrollBox1.OnScrollHorz := MyScrollHorz;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
 btTemizle.Click;
 Application.ProcessMessages;
 btDoldur.Click;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
 xBitmap := TBitmap.Create;
 xBitmap.Assign( Image1.Picture.Bitmap );
 If FileExists( ChangeFileExt(Application.Exename, '_Koordinat.TXT') )
   then ListBox1.Items.LoadFromFile( ChangeFileExt(Application.Exename, '_Koordinat.TXT') );
end;

procedure TForm1.ListBox1DblClick(Sender: TObject);
begin
 if ListBox1.ItemIndex >= 0 then ListBox1.Items.Delete(ListBox1.ItemIndex);
 FormResize(Nil);
end;

procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
 boolDown := true;
end;

procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
 Y: Integer);
Var
 deltax, deltay,
 x1, y1 : Integer;
begin
 x1 := Trunc( X / (Image1.Width  / Image1.Picture.Bitmap.Width ) );
 y1 := Trunc( Y / (Image1.Height / Image1.Picture.Bitmap.Height) );
 Form1.Caption := Format('X: %d, Y:%d', [x1, y1]);
 deltax := x-xsonx;
 deltay := y-xsony;
 xSonX := x;
 xSonY := y;
 if boolDown then begin
    ScrollBox1.ScrollBy( deltax div 2, deltay div 2);
 end;
end;

procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
 boolDown := False;
end;

procedure TForm1.ScrollBox1MouseWheelDown(Sender: TObject; Shift: TShiftState;
 MousePos: TPoint; var Handled: Boolean);
begin
 Image1.Width    := Image1.Width  - 10;
 Image1.Height   := Image1.Height - 10;
 PaintBox1.Width := Image1.Width;
 Application.ProcessMessages;
 btDoldurClick(btDoldur);
end;

procedure TForm1.ScrollBox1MouseWheelUp(Sender: TObject; Shift: TShiftState;
 MousePos: TPoint; var Handled: Boolean);
begin
 Image1.Width    := Image1.Width  + 10;
 Image1.Height   := Image1.Height + 10;
 PaintBox1.Width := Image1.Width;
 Application.ProcessMessages;
 btDoldurClick(btDoldur);
end;

procedure TForm1.ToolButton1Click(Sender: TObject);
begin
 With Image2.Canvas do begin
   Brush.Color := clWhite;
   Brush.Style := bsSolid;
   FillRect( ClipRect );
 end;
 Image2.Tag := TToolButton(Sender).ImageIndex;
 ImageList1.Draw( Image2.Canvas, (Image2.Width-ImageList1.Width) div 2, (Image2.Height-ImageList1.Height) div 2, Image2.Tag );
end;

procedure TForm1.MyScrollVert(Sender: TObject);
begin
 Application.ProcessMessages;
 btDoldurClick(btDoldur);
end;

procedure TForm1.MyScrollHorz(Sender: TObject);
begin
 Application.ProcessMessages;
 btDoldurClick(btDoldur);
end;

{ TScrollBox }

procedure TScrollBox.WMHScroll(var Message: TWMHScroll);
begin
  inherited;
  if Assigned(FOnScrollHorz) then  FOnScrollHorz(Self);
end;

procedure TScrollBox.WMVScroll(var Message: TWMVScroll);
begin
  inherited;
  if Assigned(FOnScrollVert) then  FOnScrollVert(Self);
end;

end.

znRV8g.gif
Saygılarımla
Muharrem ARMAN

guplouajuixjzfm15eqb.gif


Cevapla
#3
Çok teşekkür ederim @mmarman hocam bir göz atayim.

Hocam haritanın tam büyük resmini koydum resmi buraya koyayım.

Şöyle sorun var harita küçük gözüküyor ve fare ile büyütüp küçültme olmuyor delphi 10 kullanıyorum.

3A8j8r.jpg

Haritanın web'den yapılmış hali,

link: Linkleri Görebilmeniz İçin Giriş yap veya Üye Ol

Web'deki harita gibi ben yapmak istiyorum ama aynı resmi eklediğimde küçük gözüküyor ve büyültüp küçültme olmuyor.

Mesela windows fotoğraf görüntüleyicisi ile açınca istediğim büyütüp küçültme oluyor ve sağa sola aşşağı yukarı götürebiliyorum.
Cevapla
#4
Mouse tekerleği ile büyütme küçültme koymuştum.
Saygılarımla
Muharrem ARMAN

guplouajuixjzfm15eqb.gif


Cevapla
#5
Hocam aslında bunun hazır web'den yapılmışı var ama webbrowser ile denedim haritayı açıyoruz webbrowser ile ama oynatamıyoruz ama chrome da felan açınca oynatabiliyorsun.

Mause tekerleği ile denedim büyültüp küçültmüyor.
Cevapla
#6
Sana ayırdığım vakit bu kadardı.
Aslında haklısın, ücreti karşılığında yaptırman iyi fikirmiş.
Başarılar.
Saygılarımla
Muharrem ARMAN

guplouajuixjzfm15eqb.gif


Cevapla
#7
(09-08-2016, Saat: 23:42)mrmarman Adlı Kullanıcıdan Alıntı: Linkleri Görebilmeniz İçin Giriş yap veya Üye OlDaha önce gönderdiğim örneği istediğin şekle göre modifiye edip konsept bir proje hazırladım. İncelediğinde ne kadar basit olduğunu göreceksin.

Bunları bir kenarda tutmak lazım ileride lazım olur teşekkürler. Wink
Linkleri Görebilmeniz İçin Giriş yap veya Üye Ol
Kuvvete dayanamayan adalet aciz, 
Adalete dayanamayan kuvvet zalimdir.
WWW
Cevapla
#8
@mrmarman
Hocam siz yapabilirmisiniz bunu ücretli özelden konuşabilirmiyiz?

Harita'yı tam ekran yaptım Image1'de "AutoSize=TRUE" yapınca tam ekran oldu onu düzelttim.

Yapamadığım sorunlar şunlar var.

Kod:
Kod:
1- Fare ile yakınlaştırıp uzaklaştıramıyorum.
2- Diyelim haritada x,y kordinatına git buttonu ekleyip o kısıma gitmeyi istiyorum.
3- Harita'yı 0,0 dan çekiyorum boşluk kalıyor 0,0 dan sonra çekilmemesi gerekiyor onu bir türlü çözemedim.
4- Haritanın en alt sol köşesine caption'daki gibi X,Y kordinatını sabitlemek istiyorum.
5- Haritada diyelim bir bölgede nesne var eğer harita dışındaysa,

SAĞ TARAF: →
SOL TARAF: ←
YUKARI: ↑
AŞŞAĞI: ↓

olarak göstermek istiyorum.

Düzenlenmiş halini bakmak isteyenler,

link: Linkleri Görebilmeniz İçin Giriş yap veya Üye Ol

Yardımcı olursanız çok sevinirim, teşekkürler.
Cevapla
#9
(09-08-2016, Saat: 23:42)mrmarman Adlı Kullanıcıdan Alıntı: Linkleri Görebilmeniz İçin Giriş yap veya Üye OlDaha önce gönderdiğim örneği istediğin şekle göre modifiye edip konsept bir proje hazırladım. İncelediğinde ne kadar basit olduğunu göreceksin.

Linkleri Görebilmeniz İçin Giriş yap veya Üye Ol

Kaynak Kodu
Var
 xBitmap : TBitmap;
 xSonX, xSonY : Integer;
 boolDown : Boolean = False;

procedure TForm1.btTemizleClick(Sender: TObject);
begin
 Image1.Picture.Graphic := xBitmap;
end;

procedure TForm1.ekilEkle1Click(Sender: TObject);
Var
 x1, y1 : Integer;
begin
 x1 := Trunc( xSonX / (Image1.Width  / Image1.Picture.Bitmap.Width ) );
 y1 := Trunc( xSonY / (Image1.Height / Image1.Picture.Bitmap.Height) );
 ListBox1.Items.Add( Format('%.3d,%.3d@%.2d', [ X1, Y1, Image2.Tag ]) );
 FormResize(Nil);
end;

procedure TForm1.btDoldurClick(Sender: TObject);
Var
 i : Integer;
 x, y : Integer;
 imageIdx: Integer;
 Satir : String;
 x1, y1 : Integer;
begin
 for i := 0 to ListBox1.Count - 1 do begin
   Satir := ListBox1.Items[i];
   x := StrToInt( Copy(Satir, 1, Pos(',', Satir) -1) );
   System.Delete(Satir, 1, Pos(',', Satir));
   y := StrToInt( Copy(Satir, 1, Pos('@', Satir) -1) );
   System.Delete(Satir, 1, Pos('@', Satir));
   imageIdx :=StrToInt(Trim(Satir));

   x1 := Trunc( X * (Image1.Width  / Image1.Picture.Bitmap.Width ) ) - 19;
   y1 := Trunc( Y * (Image1.Height / Image1.Picture.Bitmap.Height) ) - 19;

   ImageList1.Draw( PaintBox1.Canvas, x1-5, y1-5, ImageIdx);
   //with PaintBox1.Canvas do begin
     //Brush.Style := bsSolid;
     //Brush.Color := clYellow;
     //Pen.Color   := clBlue;
     //Pen.Width   := 3;
     //Rectangle(x1-5, y1-5, x1+5, y1+5);
   //end;
 end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 ListBox1.Items.SaveToFile( ChangeFileExt(Application.Exename, '_Koordinat.TXT') );
 xBitmap.Free;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 PaintBox1.Width  := Image1.Width;
 PaintBox1.Height := Image1.Height;
 ScrollBox1.OnScrollVert := MyScrollVert;
 ScrollBox1.OnScrollHorz := MyScrollHorz;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
 btTemizle.Click;
 Application.ProcessMessages;
 btDoldur.Click;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
 xBitmap := TBitmap.Create;
 xBitmap.Assign( Image1.Picture.Bitmap );
 If FileExists( ChangeFileExt(Application.Exename, '_Koordinat.TXT') )
   then ListBox1.Items.LoadFromFile( ChangeFileExt(Application.Exename, '_Koordinat.TXT') );
end;

procedure TForm1.ListBox1DblClick(Sender: TObject);
begin
 if ListBox1.ItemIndex >= 0 then ListBox1.Items.Delete(ListBox1.ItemIndex);
 FormResize(Nil);
end;

procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
 boolDown := true;
end;

procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
 Y: Integer);
Var
 deltax, deltay,
 x1, y1 : Integer;
begin
 x1 := Trunc( X / (Image1.Width  / Image1.Picture.Bitmap.Width ) );
 y1 := Trunc( Y / (Image1.Height / Image1.Picture.Bitmap.Height) );
 Form1.Caption := Format('X: %d, Y:%d', [x1, y1]);
 deltax := x-xsonx;
 deltay := y-xsony;
 xSonX := x;
 xSonY := y;
 if boolDown then begin
    ScrollBox1.ScrollBy( deltax div 2, deltay div 2);
 end;
end;

procedure TForm1.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
 boolDown := False;
end;

procedure TForm1.ScrollBox1MouseWheelDown(Sender: TObject; Shift: TShiftState;
 MousePos: TPoint; var Handled: Boolean);
begin
 Image1.Width    := Image1.Width  - 10;
 Image1.Height   := Image1.Height - 10;
 PaintBox1.Width := Image1.Width;
 Application.ProcessMessages;
 btDoldurClick(btDoldur);
end;

procedure TForm1.ScrollBox1MouseWheelUp(Sender: TObject; Shift: TShiftState;
 MousePos: TPoint; var Handled: Boolean);
begin
 Image1.Width    := Image1.Width  + 10;
 Image1.Height   := Image1.Height + 10;
 PaintBox1.Width := Image1.Width;
 Application.ProcessMessages;
 btDoldurClick(btDoldur);
end;

procedure TForm1.ToolButton1Click(Sender: TObject);
begin
 With Image2.Canvas do begin
   Brush.Color := clWhite;
   Brush.Style := bsSolid;
   FillRect( ClipRect );
 end;
 Image2.Tag := TToolButton(Sender).ImageIndex;
 ImageList1.Draw( Image2.Canvas, (Image2.Width-ImageList1.Width) div 2, (Image2.Height-ImageList1.Height) div 2, Image2.Tag );
end;

procedure TForm1.MyScrollVert(Sender: TObject);
begin
 Application.ProcessMessages;
 btDoldurClick(btDoldur);
end;

procedure TForm1.MyScrollHorz(Sender: TObject);
begin
 Application.ProcessMessages;
 btDoldurClick(btDoldur);
end;

{ TScrollBox }

procedure TScrollBox.WMHScroll(var Message: TWMHScroll);
begin
  inherited;
  if Assigned(FOnScrollHorz) then  FOnScrollHorz(Self);
end;

procedure TScrollBox.WMVScroll(var Message: TWMVScroll);
begin
  inherited;
  if Assigned(FOnScrollVert) then  FOnScrollVert(Self);
end;

end.

znRV8g.gif

Merhabalar,
dosya silinmiş acaba tekrar ekleyebilirmisiniz, 
çok güzel bir proje örneği teşekkürler,
mail adresim : selahattin@bilgitekteknoloji.com
Cevapla

Konuyu Paylaş : facebook gplus twitter



Konu ile Alakalı Benzer Konular
Konular Yazar Yorumlar Okunma Son Yorum
  Kullanıcı Takip Programı Yazdırılacak canbir 2 89 21-06-2018, Saat: 09:07
Son Yorum: masteryoda



Konuyu Okuyanlar: 1 Ziyaretçi