Soubor s daty->Canvas – Delphi – Fórum – Programujte.com

Dejme tomu, že mám v souboru 360 řádků po 90 prvcích

0.1545;0.1542;0.1539;...

0.1235;0.1234;0.1253...

.

.

.

Image1.Canvas.Brush.Style:=bsclear;



for i:=1 to 90 do begin

  Image1.Canvas.Ellipse((Image1.Width-i*5) div 2,(Image1.Height-i*5) div 2,(Image1.Width+i*5) div 2,(Image1.Height+i*5) div 2);

end;



for i:=0 to 360 do begin

  Image1.Canvas.MoveTo(Image1.Width div 2,Image1.Height div 2);

  Image1.Canvas.LineTo(trunc(Image1.Width div 2+konst*cos(i/180*pi)),Image1.Height div 2-trunc(konst*sin(i/180*pi)));

end;

Projdeš data a vybarvíš si podle nich bitmapu (nejlépe v paměti). Algoritmus převodu hodnoty na barvu asi znáš. Přepočítat souborové "souřadnice" na souřadnice v bitmapě asi taky problém nebude. Jediný zádrhel bude asi v tom, že to nebude 1:1 na pixely, ale určitě lze nějak určit region, který se následně vyplní zvolenou barvou.

Problém je právě ta poslední věta - jak určit ten region. Jinak je mi všechno jasné a ten obdélník už mi to maluje, i převod do polárních souřadnic jsem zvládl, ale teď jak určit ten region.

Jen pro upřesnění: Tady to zkouším pomocí PutPixel, ale není to samozřejmě ono...

Něco v tomhle stylu?...

Ano, to je přesně ono!

Upozorňuju že jsem v tomhle naprostý amatér - tak nekamenovat.

const

  MaxElev = 90;

  MaxAzim = 360;

  PiDegs = 180;



type

  AoV = Array[1..MaxAzim,1..MaxElev] of Double;



procedure LoadValues(var MapValues: Aov);

var

  i,j:  Integer;

begin

//zde by mělo být nahrání hodnot ze souboru - nahrazeno pseudonáhodnými hodnotami

Randomize;

For i := 1 to MaxAzim do

  For j := 1 to MaxElev do

    begin

      MapValues[i,j] := Random;

    end;

end;



Function GetValueColor(const Value: Double): TColor;

var

  i:  Integer;

begin

//převedení hodnoty na barvu - předělat dle libosti

i := Trunc(High(Byte) * Value);

Result := RGB(i,i,i);

end;



Function GetCoordinates(const Azimut: Integer; const Center: TPoint; const Radius: Double): TPoint;

var

  X,Y:  Double;

begin

//souřadnice na jednotkové kružnici (Sin a Cos jsou prohozené schválně!)

X := Sin((Azimut / PiDegs) * Pi);

Y := Cos((Azimut / PiDegs) * Pi);

//výsledný bod

Result := Point(Center.X + Trunc(X * Radius),Center.Y - Trunc(Y * Radius));

end;



procedure DrawMap(const SideLength: Integer; const Values: AoV; var Map: TBitmap);

const

  MinSafeRadius = 512{px};

  //poloměr kružnice na které jsou body určující kruhovou výseč pro daný azimut,

  //zabrání se tím výraznějším grafickým artefaktům poblíž středu mapy (resp.

  //chybám ve vykreslení výsečí)

var

  i,j:                    Integer;

  Center, BeginPt, EndPt: TPoint;

  Radius:                 Double;

begin

With Map, Map.Canvas do

begin

//střed kruhové mapy

Center := Point(SideLength div 2, SideLength div 2);

//nastavení vlastností bitmapy a jejího canvasu

Width := SideLength;

Height := SideLength;

PixelFormat := pf24bit; //mohlo by se dát i 32bit, ale takhle to bude

                        //žrát méně paměti, ale při 32bit to bude asi rychlejší

Brush.Style := bsSolid;

Brush.Color := clWhite;

Pen.Style := psSolid;

//podbarvení bílou barvou

FillRect(Rect(0,0,Width,Height));

//vykreslení kruhových výsečí (azimut) na různých poloměrech (elevace)

For i := 1 to MaxAzim do

  For j := 1 to MaxElev do

    begin

      //************************************************************************

      //nevím jak se má vykreslovat elevace, jestli s jednotnou velikostí

      //dílů nebo s proměnlivou ( = průmět bodu daného elevací na pokouli do

      //vodorovné roviny), takže si vyberte co je vhodnější



      //***

      //poloměr kreslené kružnice (v px) - proměnlivý rozestup soustředných kruhů

      Radius := (Cos(((j - 1) / PiDegs) * Pi) * SideLength) / 2;



      //***

      //poloměr kreslené kružnice (v px) - jednotný rozestup soustředných kruhů

      //Radius := (((MaxElev - (j - 1)) / MaxElev) * SideLength) / 2;



      //************************************************************************

      //získání bodů určujících kruhovou výseč

      BeginPt := GetCoordinates(i,Center,MinSafeRadius);

      EndPt := GetCoordinates(i-1,Center,MinSafeRadius);

      //nastavení barev

      Pen.Color := GetValueColor(Values[i,j]);

      Brush.Color := GetValueColor(Values[i,j]);

      //vykreslení kruhové výseče

      With Center do

        Pie(X - Trunc(Radius),Y - Trunc(Radius),X + Trunc(Radius),Y + Trunc(Radius),BeginPt.X,BeginPt.Y,EndPt.X,EndPt.Y);

    end;

end;

end;



procedure TForm1.BitBtn1Click(Sender: TObject);

var

  Bmp:        TBitmap;

  MapValues:  AoV;

begin

//načtení hodnot

LoadValues(MapValues);

//vytvoření pracovní bitmapy

Bmp := TBitmap.Create;

//vykreslení mapy do pracovní bitmapy

DrawMap(Image1.Width,MapValues,Bmp);

//přiřazení pracovní bitmapy do Timage

Image1.Picture.Assign(Bmp);

//vykreslení do souboru ve větším rozlišení - můžete vymazat

DrawMap(1024,MapValues,Bmp);

Bmp.SaveToFile('test.bmp');

//uvolnění prostředků pracovní bitmapy

Bmp.Free;

end;

Tak tohle je naprosto super, děkuji!