Version:0.9
StartHTML:0000000105
EndHTML:0000547403
StartFragment:0000001053
EndFragment:0000547387
mXScriptasHTML
program PatternFrmDesignStudy_Weather_Report477_Station;
{$DEFINE PATTERNS}
procedure parseReg(regKey: string; rootKey:byte); forward;
function ListView_SetTextColor(hwnd: HWND; clrText: TColorRef): Bool; forward;
function FindDesktopWindow: HWND; forward;
function IsDesktopTransparent: Boolean; forward;
procedure SetDesktopIconColor(Foreground,Background: TColor; Trans:Boolean); forward;
procedure SetImageTemperatur(alistitem: Tlistitem); forward;
procedure SetImageTemperaturPredict(alistitem: Tlistitem; aicon: string); forward;
procedure TFrm_UpdateClick(Sender: TObject); forward;
Procedure sunrisesetRouter(lon, lat: float); forward;
function GetGeoInfoMap4save(const lat,lon, zoom: double; asize: integer;
const UrlGeoLookupInfo, apath: string): string; forward;
Procedure loadPredictForm; forward;
var
StatusBar1: TStatusBar;
MainMenu1: TMainMenu;
ImageList1: TCustomImageList;
ImageList2: TCustomImageList;
tbtnGenerator: TToolButton;
Generator: TMenuItem;
progBar: TProgressBar;
TreeView1: TTreeView;
Splitter1: TSplitter;
view, pview: TListView;
ImageList4: TImageList;
ImageList5: TImageList;
Fractals: TMenuItem;
options: TMenuItem;
tbtnTrans: TToolButton;
mnOpentree: TMenuItem;
memMon: TMemo;
frmMon: TForm;
mem2: TMemo;
dlgSearch: TFindDialog;
ws_url: string;
{$IFDEF PATTERNS}
myWS: IVCLScanner;
{$ENDIF}
ListItem, listitem2: TListItem;
mainForm1: TForm;
myEdit: TEdit;
statBar1, statbar2: TStatusBar; selectFile: string;
hh,mm: word;
ss,ms: Word;
asock: TCustomSocket; actlocation: string;
var ageofrm: TForm;
zoomf, latf, lonf: double;
const LVM_FIRST = $1000;
const LVM_SETCOLUMNWIDTH = LVM_FIRST + 30;
LVM_SETTEXTCOLOR = LVM_FIRST + 36;
LVM_GETTEXTBKCOLOR = LVM_FIRST + 37;
LVM_SETTEXTBKCOLOR = LVM_FIRST + 38;
LVM_REDRAWITEMS = LVM_FIRST + 21;
LVM_GETITEMCOUNT = LVM_FIRST + 4;
COLOR_DESKTOP = 1;
COLOR_MAX = 15;
UrlWeatherReport25=
'http://api.openweathermap.org/data/2.5/weather?q=%s&units=metric&APPID'+
'=55013bf3d09cfb0619989a00ed5bed09';
UrlWeatherReport25_Forecast=
'http://api.openweathermap.org/data/2.5/forecast?q=%s&units=metric&APPID'+
'=55013bf3d09cfb0619989a00ed5bed09';
mapboxAPIEKON21_test=
'https://api.mapbox.com/geocoding/v5/mapbox.places/%s.json?country=%s'+
'&access_token=pk.eyJ1IjoibWF4Ym94IiwiYSI6ImNpdjltZG5vdjAwMGsyemw1b3dpcGxkdWQifQ.ZUbdigkLmcLcX0cCQsds-A';
mapboxAPIEKON27= 'https://api.mapbox.com/styles/v1/mapbox/streets-v12/static/%.2f,%.2f,%2.f,0,60/%dx%d?access_token=pk.eyJ1IjoibWF4Ym94IiwiYSI6ImNsZ2t5aXdvdzFrZXozcXJyangwbHVxenYifQ._AQqFCDI-PrUqh0bnnebeA';
const WeatherREX =
'"id":([\w]+).*"main":"([\w\s]+)".*"description":"([\w\s]+)".*"temp":([\d\.\-]+).*"pressure":([0-9]+).*'+'"humidity":([0-9]+).*"temp_min":([\d\.\-]+).*"temp_max":([\d\.\-]+).*"country":"([\w\s]+).*"name":"([\w\s‘]+)"';
WeatherREX2 =
'"id":([\w]+).*"main":"([\w\s]+)".*"description":"([\w\s]+)".*"temp":([\d\.\-]+).*'+
'"temp_min":([\d\.\-]+).*"temp_max":([\d\.\-]+).*'+ '"pressure":([0-9]+).*'+ '"humidity":([0-9]+).*'+ '"country":"([\w\s]+).*"name":"([\w\s‘]+)"';
WeatherREX2Predict =
'"id":([\w]+).*"main":"([\w\s]+)".*"description":"([\w\s]+)".*"temp":([\d\.\-]+).*'+
'"pressure":([0-9]+).*'+ '"humidity":([0-9]+).*'+ '"country":"([\w\s]+).*"name":"([\w\s‘]+)"';
Const GEOCoordREX = '"lon":([\d\.-]+).*,"lat":([\d\.-]+).*';
jsonstr=
'GEO_Weather_Report: {"coord":{"lon":14.16,"lat":46.62},"weather":[{"id":501,"main":"Rain","description":"moderate rain","icon":"10d"}],"base":"cmc stations","main":{"temp":19.93,"pressure":1009,"humidity":64,"temp_min":17,"temp_max":21.67},"wind":{"speed":2.6,"deg":200},"rain":{"1h":1.17},"clouds":{"all":75},"dt":1439818945,"sys":{"type":1,"id":5931,"message":0.0042,"country":"AT","sunrise":1439784246,"sunset":1439834986},"id":2771894,"name":"Maria Worth","cod":200}';
jsonip=
'MyPublicIP: { '+
'"ip": "188.60.54.133",'+
'"hostname": "133.54.60.188.dynamic.wline.res.cust.swisscom.ch",'+
'"city": "Lausanne",'+
'"region": "Vaud",'+
'"country": "CH",'+
'"loc": "46.5200,6.6300",'+
'"org": "AS3303 Swisscom (Switzerland) Ltd",'+
'"postal": "1003"}';
type Tweatherrex = record
city, country, temp, bar, humid, line,
descript, description, id, time, coord,
tempmin, tempmax: string;
end;
type Tweatherpredict = record
city, time, temp, bar, humid, description: string;
end;
var wrec: Tweatherrex;
wpred: Tweatherpredict;
function GEOCoord2Point(apistr: string): TFloatPoint;
begin
setdecimalseparator('.')
with TRegExpr.Create do try
writeln('api2point '+apistr)
Expression:= GEOCoordREX;
if Exec(apistr) then begin
result.x:= strtofloat(Match[1])
result.y:= strtofloat(Match[2])
end;
finally Free;
end;
end;
procedure getMultipleWeather(apistr: string);
var latf, lonf: double;
begin
latf:= GEOCoord2Point(apistr).y
lonf:= GEOCoord2Point(apistr).x
writeln('Coord of '+actlocation +' : '
+floattostr(latf)+' '+floattostr(lonf));
with TRegExpr.Create do try
Expression:= weatherREX2;
writeln('new test '+apistr)
if Exec(apistr) then begin
PrintF('Weather Id:%s is %s in: %s at %s° of %s pressure with %s humid',
[Match[1],Match[2],Match[10],Match[4],Match[7],Match[8]+'%']);
wrec.id:= match[1];
wrec.descript:= match[2];
wrec.description:= match[3]
wrec.temp:= match[4];
wrec.tempmin:= match[5];
wrec.tempmax:= match[6];
wrec.bar:= match[7];
wrec.humid:= match[8];
wrec.country:= match[9];
wrec.city:= match[10];
wrec.line:=
Format('WeatherId:%s is %s in: %s at %s of %s pressure with %s humid',
[Match[1],Match[2],Match[10],Match[4],Match[7],Match[8]+'%'])
wrec.coord:= floattostr(latf)+'° '+floattostr(lonf);
end else showmessage('REGEX apistr not Executed');
except
showmessage(ExceptionToString(ExceptionType, ExceptionParam));
finally Free;
end;
end;
procedure getMultipleWeatherForecast(apistr: string);
begin
with TRegExpr.Create do try
Expression:= weatherREX2Predict;
if Exec(apistr) then begin
PrintF('Weather Id:%s is %s in: %s at %s° of %s pressure with %s humid',
[Match[1],Match[2],Match[3],Match[4],Match[5],Match[6]+'%']);
wpred.city:= match[1];
wpred.description:= match[2];
wpred.temp:= match[3];
wpred.bar:= match[4];
wpred.humid:= match[5];
end else showmessage('REGEX Forecast apistr not Executed');
except
showmessage(ExceptionToString(ExceptionType, ExceptionParam));
finally Free;
end;
end;
procedure AddlistItem(Item: TListItem);
var anum: float;
begin
with Item do begin
Caption:= wrec.id+' '+wrec.city+' :'+wrec.country;
SubItems.Add(wrec.temp+'° hPa: '+wrec.bar+' humid: '
+wrec.humid+'% '+'at '+wrec.coord);
SubItems.Add(wrec.description);
anum:=StrToFloat(copy(wrec.temp, 1, 2));
anum:= anum / 2
anum:= ((strtofloat(wrec.tempmax) + strtofloat(wrec.tempmin))/2)
SubItems.Add(floattoStr(anum));
end;
end;
procedure AddlistItemPredict(Item: TListItem);
var anum: float;
begin
with Item do begin
Caption:=' '+wpred.city+' :';
SubItems.Add(wpred.temp+'° hPa: '+wpred.bar+' humid: '
+wpred.humid+'% ');
SubItems.Add(wpred.description);
anum:=StrToFloat(copy(wpred.temp, 1, 2));
anum:= anum / 2
SubItems.Add(floattoStr(anum));
end;
end;
function FindDesktopWindow: HWND;
var Window: HWND;
begin
Window:= FindWindow('Progman','Program Manager');
Window:= FindWindowEx(Window,0,'SHELLDLL_DefView','');
Window:= FindWindowEx(Window,0,'SysListView32','');
Result:= Window;
end;
function ListView_GetTextBkColor(hwnd: HWND): TColorRef;
begin
Result:= SendMessage(hwnd, LVM_GETTEXTBKCOLOR, 0, 0);
end;
function ListView_SetTextBkColor(hwnd: HWND; clrTextBk: TColorRef): Bool;
begin
Result:= Bool( SendMessage(hwnd, LVM_SETTEXTBKCOLOR, 0, clrTextBk) );
end;
function ListView_RedrawItems(hwndLV: HWND; iFirst, iLast: Integer): Bool;
begin
Result:= Bool( SendMessage(hwndLV, LVM_REDRAWITEMS, iFirst, iLast) );
end;
function ListView_GetItemCount(hWnd: HWND): Integer;
begin
Result:= SendMessage(hWnd, LVM_GETITEMCOUNT, 0, 0);
end;
function IsDesktopTransparent: Boolean;
var
BkColor: COLORREF;
begin
BkColor:= ListView_GetTextBkColor(FindDesktopWindow);
if BkColor <> $FFFFFFFF then
Result:= False
else
Result:= True;
end;
procedure SetDesktopIconColor(Foreground, Background: TColor; Trans: Boolean);
var Window: HWND;
begin
Window := FindDesktopWindow;
if Trans = True then
ListView_SetTextBkColor(Window,$FFFFFFFF)
else
ListView_SetTextBkColor(Window,Background);
ListView_SetTextColor(Window, Foreground);
ListView_RedrawItems(Window,0,ListView_GetItemCount(Window) - 1);
UpdateWindow(Window);
end;
procedure TFrm_FormCreate(Sender: TObject);
begin
tbtnTrans.Enabled:=false;
self.Visible:=true;
self.Height:= 550;
self.ClientHeight:= 500;
self.Width:= 765;
self.ClientWidth:= 755;
end;
procedure TFrm_FormActivate(Sender: TObject);
begin
self.Caption:='Delphi Python Design Patterns';
progBar.visible:= false;
statusbar1.simplepanel:= true;
statusBar1.SimpleText:='max@kleiner.com';
end;
procedure TFrm_FormDestroy(Sender: TObject);
begin
messagebeep(0);
end;
procedure TFrm_mnEncryptClick(Sender: TObject);
var od1: TOpenDialog;
step, size: Longint;
passB: integer;
psStr: string;
crMode: byte;
F, F1: TextFile;
begin
if TMenuItem(sender).Name = 'mnDecrypt' then
crMode:= 2 else crMode:= 1;
od1:= TOpenDialog.Create(NIL);
step:= 0;
if psStr = '' then begin
exit;
end;
od1.execute;
try
passB:= strToInt(psStr);
if length(od1.FileName) < 1 then
else begin
AssignFile(F, OD1.FileName);
Reset(F);
with progbar do begin
visible:= True;
Min:= 0; Max:= Size;
Step:= 1;
end;
if crMode = 1 then begin
AssignFile(F1, 'chiffrat.txt');
Rewrite(F1);
while not EOF do begin
end;
end else if crMode = 2 then begin
AssignFile(F1, 'clear.txt');
Rewrite(F1);
while not EOF do begin
end;
end; end; finally
flush(F1);
od1.Free;
closeFile(F);
closeFile(F1);
progbar.Visible:= False;
end;
end;
function TFrm_OpenRead(myfile: String) : String;
var f: TextFile;
content, row: string;
begin
content:= '';
if fileexists(myfile) then begin
Assignfile(f, myfile);
Reset(f);
while not eof do begin
content:= content + row + chr(13);
end;
CloseFile(F);
Result := content;
end else
end;
procedure TFrm_scanFile_orStream(myFile: string);
var
Tempstr, cont: String;
position: integer;
begin
with view do begin
if fileexists(myFile) then
cont:= TFrm_openRead(myFile) else
cont:= myfile;
position:= pos(chr(13), cont);
if (position = 0) and (length(trim(cont)) > 0) then begin
ListItem:= Items.Add;
ListItem.Caption := cont;
exit
end;
while position > 0 do begin
TempStr:= cont;
delete(TempStr, position, length(TempStr) - position + 1);
delete(cont, 1, position);
ListItem:= Items.Add;
ListItem.Caption := TempStr;
position:= pos(chr(13), cont);
end;
end;
end;
procedure TFrm_toogleView_orFile(ufile: string);
begin
if not assigned(mem2) then begin
mem2:= TMemo.Create(application);
mem2.parent:= view;
mem2.Align:= alclient;
mem2.Font.Size:= 12;
end;
if fileexists(uFile) then
mem2.lines.LoadFromFile(ufile)
else begin
mem2.Clear;
mem2.Lines.add(ufile);
end;
mem2.Show;
end;
procedure TFrm_Mem2Close(Sender: TObject);
begin
if assigned(mem2) then begin
mem2.clear;
mem2.Parent:= NIL;
mem2:= NIL;
mem2.Free;
end;
end;
procedure TFrm_TreeView1Change(Sender: TObject; Node: TTreeNode);
begin
view.Items.Clear;
with Treeview1.selected do begin
if Text = 'OCL' then
TFrm_scanFile_orStream('ocl_facts.txt');
if Text = 'Delegation' then
TFrm_scanFile_orStream('delegate.txt');
if Text = 'Refactoring' then
TFrm_scanFile_orStream('refactoring.txt');
if Text = 'Redesign' then
TFrm_scanFile_orStream('redesign.txt');
if Text = 'DUnit' then
TFrm_scanFile_orStream('algorithms.pas');
if Text = 'NUnit' then
TFrm_scanFile_orStream('nunit.txt');
if Text = 'Interfaces' then
TFrm_toogleview_orfile('IVCLScanner1.pas');
if Text = 'Lists' then
TFrm_toogleview_orfile('listCollect.pas');
if Text = 'Singleton' then begin
TFrm_toogleview_orfile('uSingletonF.pas');
end;
if Text = 'SingletonAlt' then
if Text = 'Observer' then begin
TFrm_toogleview_orfile('uObserver.pas');
end;
if Text = 'Template' then begin
end;
if Text = 'Strategy' then with view do begin
Clear;
listItem:= Items.Add;
listItem:= Items.Add;
listItem:= Items.Add;
listItem:= Items.Add;
end;
if Text = 'Lock' then begin
statusBar1.SimpleText:='running trans in button';
tbtnTrans.Enabled:=not(tbtnTrans.Enabled);
TFrm_toogleview_orfile('ulooktrans.pas');
end;
if Text = 'Abstract' then
if Text = 'Builder' then
TFrm_toogleview_orfile('uSingletonF.pas');
if Text = 'Factory' then
TFrm_toogleview_orfile('uObserver.pas');
if Text = 'Adapter' then
TFrm_toogleview_orfile('uObserver.pas');
if Text = 'Bridge' then
TFrm_toogleview_orfile('uFilexport.pas');
if Text = 'Composite' then
TFrm_toogleview_orfile('u_Composition.pas');
if Text = 'Decorator' then
TFrm_toogleview_orfile('uCrypto.pas');
if Text = 'Facade' then
TFrm_toogleview_orfile('marshall.pas');
if Text = 'Flyweight' then
TFrm_toogleview_orfile('uStrategy.pas');
if Text = 'Proxy' then
TFrm_toogleview_orfile('IVCLScanner1.pas');
if Text = 'Wrapper' then
TFrm_toogleview_orfile('uFilexport.pas');
if Text = 'Chain' then
TFrm_toogleview_orfile('ulooktrans.pas');
if Text = 'Command' then begin
TFrm_toogleview_orfile('uStrategy.pas');
end;
if Text = 'Interpreter' then
TFrm_toogleview_orfile('patternFrm.pas');
if Text = 'Iterator' then
TFrm_toogleview_orfile('iterator.txt');
if Text = 'Mediator' then
TFrm_toogleview_orfile('uFilexport.pas');
if Text = 'Memento' then
TFrm_toogleview_orfile('Graphics.pas');
if Text = 'State' then
TFrm_toogleview_orfile('foerderband.pas');
if Text = 'Visitor' then
TFrm_toogleview_orfile('RND.pas');
if Text = 'Automation' then
TFrm_toogleview_orfile('i2c.pas');
if Text = 'Broker' then begin
TFrm_toogleview_orfile('IVCLScanner1.pas');
{$IFDEF PATTERNS}
{$ENDIF}
end;
if Text = 'Container' then
TFrm_toogleview_orfile('income.dpr');
if Text = 'Layers' then
TFrm_toogleview_orfile('banklogic.pas');
if Text = 'Master-Slave' then
TFrm_toogleview_orfile('sortThds.pas');
if Text = 'Microkernel' then
TFrm_toogleview_orfile('shellConsts.pas');
if Text = 'Monitor' then
TFrm_toogleview_orfile('chartView.pas');
if Text = 'MVC' then
TFrm_toogleview_orfile('boldmain.pas');
if Text = 'PAC' then
TFrm_toogleview_orfile('boldbase.pas');
if Text = 'Prototyp' then
TFrm_toogleview_orfile('testmodules.pas');
if Text = 'Provider' then
TFrm_toogleview_orfile('DMU.pas');
if Text = 'Simulator' then
TFrm_toogleview_orfile('RND.pas');
if Text = 'Terminal-Server' then
TFrm_toogleview_orfile('fterminal.pas');
if Text = 'Transaction' then
TFrm_toogleview_orfile('u_dwsserver1.pas');
if Text = 'Watchdog' then
TFrm_toogleview_orfile('monForm.pas');
end; end; procedure TFrm_mnOpentreeClick(Sender: TObject);
begin
with mnOpenTree do begin
if tag=0 then begin
treeview1.FullExpand;
tag:=1
end else begin
treeview1.FullCollapse;
tag:=0;
end;
end
end;
procedure TFrm_color1Click(Sender: TObject);
begin
writeln(itoa(TColorbox(sender).selected));
writeln(ColorToString(TColorbox(sender).selected));
ListView_SetTextColor(view.Handle,TColorbox(sender).selected)
end;
procedure TFrm_FindDlgClose(Sender: TObject; var action: TcloseAction);
begin
dlgSearch.CloseDialog;
dlgSearch:= NIL;
dlgSearch.Free;
end;
procedure TFrm_mnSearchClick(Sender: TObject);
var aTop: TPoint;
begin
if not assigned(dlgsearch) then begin
dlgSearch:= TFindDialog.Create(self);
frmMon:= TForm.create(dlgSearch);
memMon:= TMemo.create(frmMon);
with mainForm1 do begin
aTop.y:=Top;
aTop.x:=Left;
end;
try
frmMon.OnClose:= @TFrm_findDlgClose; frmMon.Parent:= self;
memMon.parent:= frmMon;
memMon.setbounds(10,10,290,190);
with frmMon do begin
left:=ATop.x + view.left + 6;
show;
end;
dlgSearch.Execute
finally
end;
end else exit
end;
procedure TFrm_r1Click(Sender: TObject);
begin
parseReg('SOFTWARE\Microsoft\Windows\CurrentVersion\Run',1);end;
procedure TFrm_r2Click(Sender: TObject);
begin
parseReg('SOFTWARE\Microsoft\Windows\CurrentVersion\RunOnce',1);
end;
procedure TFrm_R3Click(Sender: TObject);
begin
parseReg('SOFTWARE\Microsoft\Windows\CurrentVersion\RunOnceEx',1);
end;
procedure TFrm_R4Click(Sender: TObject);
begin
parseReg('SOFTWARE\Microsoft\Windows\CurrentVersion\RunServices',1);
end;
procedure TFrm_R5Click(Sender: TObject);
begin
parseReg('SOFTWARE\Microsoft\Windows\CurrentVersion\RunServicesOnce',1)
end;
procedure TFrm_T1Click(Sender: TObject);
begin
parseReg('Software\Microsoft\Internet Explorer\TypedURLs',2);end;
procedure parseReg(regKey: string; rootKey:byte);
var reg: TRegistry;
mySV: TStringList;
keyContent: string;
i: integer;
begin
reg:= TRegistry.create;
try
case rootKey of
1:reg.RootKey:= HKEY_LOCAL_MACHINE;
2:reg.RootKey:= HKEY_CURRENT_USER;
end;
if reg.OpenKey(regKey, false) then begin
mySV:= TStringList.Create;
view.Items.Clear;
try
reg.GetValueNames(mySV);
for i:= 0 to mySV.Count - 1 do begin
keyContent:= mySv.Strings[i];
ListItem:= view.Items.Add;
ListItem.Caption:=
keyContent +'/ '+ reg.ReadString(keyContent);
end;
finally
mySV.Free;
end;
reg.CloseKey;
end; finally
reg.Free;
end;
end;
CONST AExponent = 4;
ANIMATEDELAY = 4;
var distX, distY, glx,gly, step, pct: float;
endX, endY, beginX, beginY: integer;
FPicRed, FStorage: TBitMap;
FNewRect: TRect;
FOldRect: tRect; FirstTime: boolean;
procedure setupAnimation();
begin
FPicRed:= TBitMap.Create;
FPicRed.transparent:= true;
FStorage:= TBitMap.Create;
FStorage.Width:= FPicred.Width;
FStorage.Height:= FPicred.Height;
Screen.Cursor:= crCross; beginX:= 20; beginY:= 20; endX:= 470; endY:= 320; glx:= 20.0; gly:= 20.0; step:= 0.01; pct:= 0.0; distX:= endX - beginX;
distY:= endY - beginY;
end;
var aFrm, aPfrm: TForm;
procedure drawE2(abeginx, abeginy, endx, endy: integer);
var i: integer;
begin
pct:= 0.0;
distX:= endX - beginX;
distY:= endY - beginY;
for i:= 1 to 100 do begin
pct:= pct+ step;
if (pct < 1.0) then begin
glx:= beginX + (pct * distX);
gly:= beginY + (power(pct, AExponent+5) * distY);
end;
afrm.repaint;
afrm.canvas.draw(round(glx)-20,round(gly-20), fPicRed);
delay(ANIMATEDELAY);
end;
end;
procedure TRebWizForm_ExamineDir;
var
FileList: TStrings;
I: Integer;
CurrDir: string;
FileListBox1: TFileListBox;
listboxfiles: TListbox;
begin
FileListBox1.Mask := '*.dpr';
FileListBox1.FileType := [ftNormal];
FileList := TStringList.Create;
try
FileList.Assign(FileListBox1.Items);
for I := 0 to FileList.Count - 1 do begin
ListBoxFiles.Items.Add (FileListbox1.Directory +
'\' + FileList[I]);
end;
FileListBox1.Mask := '*.*';
FileListBox1.FileType := [ftDirectory];
FileList.Assign(FileListBox1.Items);
CurrDir := FileListbox1.Directory;
for I := 2 to FileList.Count - 1 do begin
FileListbox1.Directory :=
CurrDir + '\' + Copy (FileList[I], 2,
Length (FileList [I]) - 2);
TRebWizForm_ExamineDir;
end;
FileListbox1.Directory := CurrDir;
finally
FileList.Free;
end;
end;
function GetGeoWeather(const location: string;
const UrlRestAPI: string): string;
var lHTTP: TIdHTTP;
lStream: TStringStream;
asyn: TSynwInfo;
begin
lHTTP:= TIdHTTP.Create(NIL);
lStream:= TStringStream.Create('');
try
try
HTTPGet(Format(UrlRestAPI,[location]),lStream);
except
writeln('OWeather_Map Exception: '+Gethtm(UrlWeatherReport25))
end;
lStream.Seek(0,0);
result:= 'GEO_Weather_Report2: '+UTF8ToString(lStream.ReadString(lStream.Size));
finally
lHTTP.Free;
lStream.Free;
end;
end;
Const RealIP_REX = '"city": "([üöä\w\s]*).*"country": "([\w\s]+).*"';
var LocalCity, LocalCountry: string;
function GetRealIP2(): String;
var LJsonObj: TJSONObject;
str: string;
http : TIdHttp;
begin
str:='';
http:=TIdHTTP.Create(Nil);
try
str:= UTF8toAnsi(http.Get('http://ipinfo.io/json'));
LJsonObj:= TJSONObject.create4(str);
with TRegExpr.Create do try
Expression:= RealIP_REX;
if Exec(str) then begin
PrintF('IP Weather Local City Name: %s ',[Match[1]])
PrintF('IP Weather Local Country Name: %s ',[Match[2]])
LocalCity:= match[1]
LocalCountry:= match[2]
localcity:= StringReplace(localcity, 'ä', 'ae', [rfReplaceAll]);
localcity:= StringReplace(localcity, 'ö', 'oe', [rfReplaceAll]);
localcity:= StringReplace(localcity, 'ü', 'ue', [rfReplaceAll]);
writeln('aeo name convert: '+localcity)
end else writeln('ip localcity not found');
finally Free;
end;
Except
writeln('get real ip EXCEPTION ')
raiselastException;
end;
result:= str;
LJsonObj.Free;
http.Free;
end;
procedure FormMouseDown(sender: TObject; Button: TMouseButton;
Shift: TShiftState; vX, vY: Integer);
begin
BitBlt(FStorage.Canvas.Handle,0,0, FPicred.Width, FPicred.Height,
afrm.Canvas.Handle, FNewRect.Left, FNewRect.Top, SRCCOPY);
pct:= 0.0;
beginX:= round(glx);
beginY:= round(gly);
endX:= vX; endY:= vY;
afrm.repaint;
drawE2(beginx,beginy, endx,endy);
end;
procedure TFrm1_trackSpeedChange(Sender: TObject);
begin
writeln(intToStr(TTrackbar(sender).Position));
Progbar.Position:= TTrackbar(sender).Position*10;
end;
procedure TFrm1_progressChange(Sender: TObject);
begin
writeln(intToStr(TTrackbar(sender).Position));
end;
procedure TFrm1_closeForm(Sender: TObject; var Action: TCloseAction);
begin
if assigned(FPicRed) then
FPicRed.Free;
FPicRed:= NIL;
if assigned(FStorage) then
FStorage.Free;
FStorage:= NIL;
imagelist1.Free;
imagelist2.Free;
view.Free;
action:= caFree;
afrm:= NIL;
Screen.Cursor:= crDefault
writeln('geo map6 form free and API closed');
end;
procedure TFrm2_closeForm(Sender: TObject; var Action: TCloseAction);
begin
Screen.Cursor:= crDefault
writeln('geo map6 forecaster form free');
end;
procedure TFrm1_CloseClick(Sender: TObject);
begin
afrm.Close;
writeln('geo map form close and free at: '+datetimetostr(now));
zoomf:= 16;
end;
procedure Map_CloseClick(Sender: TObject; var action: TCloseAction);
begin
action:= cafree;
writeln('only mapform close at: '+datetimetostr(now));
end;
const MEDIAPATH = 'examples\';
procedure OpenWeatherList(sender: TObject);
begin
if PromptForFileName(selectFile,'Files(*.*)|*.*', '', 'Select your weather filelist', MEDIAPATH, False)
then begin
end;
end;
procedure TFrm1_AddClick(Sender: TObject);
begin
actlocation:= removespaces(myedit.text);
TFrm_updateclick(self)
end;
procedure btnZoomPlusClick2(Sender: TObject);
var abitmap: TBitmap;
zoomval: integer;
begin
try
zoomf:= zoomf-1
GetGeoInfoMap4save(latf,lonf,zoomf,650,mapboxAPIEKON27,
ExePath+'examples\mX4mapbox_weatherzoom4.png')
finally
end;
end;
var APATHGLOB: string;
procedure Save1Click(Sender: TObject);
begin
openfile(APATHGLOB)
end;
function GetGeoInfoMap4save(const lat,lon, zoom: double; asize: integer;
const UrlGeoLookupInfo, apath: string): string;
var
pngStream: TMemoryStream;
internalzoomf: double;
MainMenu1: TMainMenu;
File1: TMenuItem;
begin
pngStream:= TMemoryStream.Create;
try
HttpGet(Format(UrlGeoLookupInfo,[lon,lat,zoom, asize-50,asize-50]), pngStream);
except
writeln(ExceptionToString(ExceptionType, ExceptionParam));
end;
with TLinearBitmap.Create do try
pngStream.Position:= 0;
LoadFromStream2(pngStream,'PNG');
internalzoomf:= 16;
MainMenu1:= TMainMenu.create(self)
ageofrm:= getForm2(asize+8,asize+8, clgreen,
'GEO MAP Weather 5.5: '+'zoom: '+floattostr(zoomf));
ageofrm.Menu := MainMenu1;
file1 := TMenuItem.create(ageofrm);
with file1 do begin
Caption := 'Open &File Save...'
mainmenu1.Items.Add(file1);
OnClick := @Save1Click;
end;
ageofrm.ondblclick:= @btnZoomPlusClick2;
ageofrm.onclose:= @Map_CloseClick;
paintToCanvas(ageofrm.canvas, Rect(2,2,Width,Height),false);
SaveToFile(apath);
APATHGLOB:= apath;
finally
Dispose;
Free;
pngStream.Free;
end;
end;
procedure ListClick(Sender: TObject);
begin
writeln(objecttostring(sender))
writeln(TListview(sender).selected.caption);
writeln(copy(TListview(sender).selected.caption,4,20));
actlocation:= copy(TListview(sender).selected.caption,4,20);
writeln('this acvt replace'+actlocation)
actlocation:= StrReplaceChar(actlocation, ':',',')
if isInternet then begin
sr:= GetGeoWeather(removespaces(actlocation), UrlWeatherReport25);
writeln(sr)
statbar1.panels.items[1].text:= sr; statbar1.hint:= sr;
end;
latf:= GEOCoord2Point(sr).y
lonf:= GEOCoord2Point(sr).x
writeln('coord of '+actlocation +' : '
+floattostr(latf)+' '+floattostr(lonf));
zoomf:= 16;
GetGeoInfoMap4save(latf,lonf,zoomf,650,mapboxAPIEKON27,
ExePath+'mX4mapbox_weatherapp4.png')
end;
procedure ListClick2(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
writeln(objecttostring(sender))
writeln(TListview(sender).selected.caption);
writeln(copy(TListview(sender).selected.caption,4,20));
actlocation:= copy(TListview(sender).selected.caption,4,20);
writeln('this acvt replace'+actlocation)
actlocation:= StrReplaceChar(actlocation, ':',',')
if isInternet then begin
sr:= GetGeoWeather(removespaces(actlocation), UrlWeatherReport25);
writeln(sr)
statbar1.panels.items[1].text:= sr; statbar1.hint:= sr;
end;
end;
procedure TFormListView1DblClick(Sender: TObject) ;
var Caption: string;
hts : THitTests;
ht : THitTest;
sht : string;
ListViewCursosPos : TPoint;
ListView1: TListview;
selectedItem : TListItem;
begin
ListViewCursosPos := ListView1.ScreenToClient(Mouse.CursorPos) ;
hts := ListView1.GetHitTestInfoAt(ListViewCursosPos.X, ListViewCursosPos.Y) ;
Caption := '';
begin
Caption := Format('%s %s | ',[Caption, sht]) ;
end;
selectedItem := ListView1.Selected;
Caption := Format('DblClcked : %s',[selectedItem.Caption]) ;
end;
procedure ListClickPredict(Sender:TObject;Button:TMouseButton; Shift:TShiftState;X,Y:Integer);
begin
writeln(itoa(TListview(sender).itemindex))
statbar2.panels.items[1].text:=
TListview(sender).items[TListview(sender).itemindex].subitems[0];
writeln('itemindex: '+ TListview(sender).items[TListview(sender).itemindex].subitems[1]);
statbar2.hint:= statbar2.panels.items[1].text;
end;
procedure tbtnScanClick(Sender: TObject);
begin
writeln(objecttostring(sender))
if isInternet then begin
sr:= GetGeoWeather(removespaces(actlocation), UrlWeatherReport25);
writeln(sr)
end;
end;
const PicPath = '\examples\images\';
procedure EditColumn(Item: TListItem; Col: byte; const Text: string);
begin
if Col = 0 then
Item.Caption:= Text
else begin
while Item.SubItems.Count < Col do
Item.SubItems.Add('');
Item.SubItems[Col -1] := Text;
end;
end;
procedure Change(AListView: TListView; const ARowIndex, AColIndex: Integer;
const ANewContent: string);
var
i: Integer;
vItem: TListItem;
begin
vItem := AListView.Items[ARowIndex];
if AColIndex=0 then
vItem.Caption := ANewContent
else begin
for i := vItem.SubItems.Count to AColIndex+1 do
vItem.SubItems.Add('');
vItem.SubItems[AColIndex] := ANewContent;
end;
end;
procedure TFrm_UpdateClick(Sender: TObject);
begin
ListView_SetTextBkColor(view.handle, $7dcced) if isInternet then begin
sr:= GetGeoWeather(actlocation, UrlWeatherReport25);
writeln('update: '+sr+' '+actlocation)
getMultipleWeather(sr)
ListItem:= view.Items.Add;
AddlistItem(listitem)
SetImageTemperatur(listitem)
listitem.makevisible(false);
statbar1.panels.items[1].text:= sr;
statbar1.hint:= sr;
end;
end;
const
N = 31; Alpha = 0.05; procedure WriteRegressionResults(X, Y, Ycalc, B : TVector;
V : TMatrix;
Test : TRegTest;
Tc, Fc : Float);
var
Line1,
Line2 : String; Delta : Float; Sr : Float; SB : Float; I : Integer; begin
Line1:= StrChar(73, '-');
Line2:= StrChar(43, '=');
WriteLn(Line2);
WriteLn('Linear regression: Y = B(0) + B(1) * X');
WriteLn(Line1);
WriteLn('Parameter Est.value Std.dev. '+
floattostr(100 * (1 - Alpha))+ '% Confidence Interval');
WriteLn(Line1);
for I:= 0 to 1 do begin
SB := Sqrt(V[I][I]);
PrintF('B(%d) %17.8f %17.8f %17.8f ; %17.8f',
[I,B[I],SB,(B[I]- Tc * SB),(B[I] + Tc * SB)])
end;
WriteLn(Line1);
WriteLn('Number of observations : n = '+itoa(N));
with Test do begin
Sr := Sqrt(Vr);
WriteLn('Residual error : s = '+floattoStr(Sr));
WriteLn('Coeffic. of correlation : r = '+floattostr((Sgn(B[1])*Sqrt(R2))));
WriteLn('Coefficient of determination: r2 = '+floattostr(R2));
end;
WriteLn(Line1);
PrintF(' %-13s %-12s %-12s %-12s %-12s %-12s',
['i','Y obs.','Y calc.','Residual','Std.dev.','Std.res.']);
WriteLn(Line1);
for I := 1 to N do begin
Delta := Y[I] - Ycalc[I];
PrintF('B(%d) %12.4f %12.4f %12.4f %12.4f %12.4f',
[I,Y[I],Ycalc[I],Delta,Sr, (Delta / Sr)])
end;
WriteLn(Line2);
end;
procedure AutoScale2(X : TVector; Lb, Ub : Integer; Scale : TScale;
var XMin, XMax, XStep : Float); external 'AutoScale@dmath';
procedure letForecastRegression_Graph(datlist: TStringlist);
var afrm: TForm; acanvas: TCanvas;
B : TVector; XX, YY : TVector; Ycalc : TVector; V : TMatrix; Test : TRegTest; Tc : Float; Fc : Float; I : Integer; Ymin, Ymax, Ystep: float; Scale : TScale;
Ymin2: float;
X : TVector; Lb, Ub : Integer; aScale : TScale; var XMin, XMax, XStep : Float;
begin
DimVector(XX, N);
DimVector(YY, N);
DimVector(Ycalc, N);
DimVector(B, 1);
DimMatrix(V, 1, 1);
aFrm:= getForm2(1100,420, clweblightgreen,'weather forecast graphX'); acanvas:= aFrm.canvas;
acanvas.FillRect(Rect(0, 0, afrm.Width, afrm.Height));
for I := 1 to N do begin
XX[I] := I /30;
YY[I] := strtofloat(datlist[I])/35;
end;
LinFit(XX, YY, 1, N, B, V);
for I := 1 to N do
Ycalc[I] := B[0] + B[1] * XX[I];
RegTest(YY, Ycalc, 1, N, V, 0, 1, Test);
WriteRegressionResults(XX, YY, Ycalc, B, V, Test, Tc, Fc);
SetWindow(afrm.canvas, 30, 150, 25, 150, True);
Ymin:= -0.5; Ymax:= 0.9; Ystep:= 1;
SetOyScale(LinScale, Ymin, Ymax, Ystep); SetGraphTitle('Linear Weather Regression Demo for'+actlocation+' '+datetostr(now));
afrm.caption:= 'Linear Weather Regression Demo for'+actlocation+' '+datetostr(now);
SetOxTitle('X_Time = 5 Days');
SetOyTitle('Y_Temp -10+30');
PlotOxAxis(afrm.canvas);
PlotOyAxis(afrm.canvas);
WriteGraphTitle(afrm.canvas);
SetLineParam(1, psSolid, 0, clred); PlotCurveWithErrorBars(afrm.canvas,(XX), YY, Ycalc, 1, 1, N-1, 1)
for I := 1 to N do
Ycalc[I] := (B[0] + B[1] * XX[I]);
SetLineParam(1, psSolid, 0, clblue);
PlotCurve(afrm.canvas,(XX), Ycalc, 1, N-1, 1);
writeln('Regression calc & fit done')
end;
procedure TFrm_ForecastClick(Sender: TObject);
var tmps, srt, descript, atemp, aicon: string;
mlist, templist: TStringlist; k: integer;
begin
if isInternet then begin
srt:= GetGeoWeather(actlocation, UrlWeatherReport25_Forecast);
mlist:= TStringlist.create;
templist:= TStringlist.create;
Strtolist(srt, mlist, '}')
writeln('Count of forecast list line: '+itoa(mlist.count))
for k:= 0 to mlist.count-1 do begin
if pos('"dt_txt":',mlist.strings[k]) > 0 then
tmps:= mlist.strings[k] ;
if pos('"temp":',mlist.strings[k]) > 0 then
writeln(itoa(k)+tmps+' '+mlist.strings[k]+CRLF);
if pos('"main":',mlist.strings[k]) > 0 then
writeln(itoa(k)+mlist.strings[k]+CRLF);
end;
mlist.free;
writeln('Forecast for: '+mlist.text+' '+actlocation)
writeln('Forecast end report for: '+actlocation)
loadpredictForm;
mlist:= TStringlist.create;
Strtolist(srt, mlist, '}')
writeln('Count of forecast list2: '+itoa(mlist.count))
for k:= 0 to mlist.count-2 do begin
if pos('"dt_txt":',mlist.strings[k]) > 0 then begin
tmps:= copy(mlist.strings[k],pos('"dt_txt":',mlist.strings[k])+10,17)
if pos('"temp":',mlist.strings[k+1]) > 0 then begin
tmps:= tmps+' '+mlist.strings[k+1];
with TPerlRegEx.Create do begin;
Options:= [preCaseLess];
RegEx:= '"temp":([\d\.\-]+){2,}'; subject:= mlist.strings[k+1];
if match then atemp:= copy(groups[0],8,6); Free;
end;
templist.add((atemp));
end;
if pos('"main":',mlist.strings[k+2]) > 0 then begin
descript:= copy(mlist.strings[k+2],pos('"main":',mlist.strings[k+2])+7,60);
aicon:= copy(mlist.strings[k+2],pos('"icon":',mlist.strings[k+2])+8,3)
end;
ListItem:= pview.Items.Add;
with listItem do begin
Caption:= actlocation;
SubItems.Add(tmps);
SubItems.Add(descript);
SubItems.Add(atemp);
SetImageTemperaturPredict(listitem, aicon)
end;
end;
end;
mlist.free;
for it:= 1 to templist.count-1 do write(templist[it]+ ' ');
letForecastRegression_Graph(templist);
templist.Free;
end;
end;
procedure Edit1KeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then begin
Key := #0;
actlocation:= removespaces(myedit.text);
TFrm_updateclick(self)
if sender is TListview then
writeln('list view return key pressed at: '+(TListview(sender).selected.caption));
end;
end;
function ListView_SetTextColor(hwnd: HWND; clrText: TColorRef): Bool;
begin
Result:= Bool( SendMessage(hwnd, LVM_SETTEXTCOLOR, 0, clrText) );
end;
procedure TMyControl_TriggerHint(Hint: String);
var
Message: TMessage;
FGridHintFlag: boolean;
begin
Self.Hint:= Hint;
if Hint='' then begin
Application.HideHint;
Application.CancelHint;
end
else begin
Application.CancelHint;
FGridHintFlag:=Self.Hint<>'';
Self.Hint:=Hint;
if Hint<>'' then begin
Application.HintMouseMessage(Self, Message);
end;
end;
end;
Const PBM_SETBARCOLOR = (WM_USER + 9);
Procedure initTabletmode;
var
aMessage: TMessage;
begin
Application.HintColor := $8deeed
Application.HintMouseMessage(Self, aMessage)
Application.HintPause := 250; Application.HintHidePause := 13000; end;
Procedure RegisterHiddenMenu;
var
Comp: TComponent;
begin
Comp := Application.MainForm.FindComponent('MenuItemName');
if Comp is TMenuItem then
TMenuItem(Comp).Visible := True;
end;
procedure SetImageTemperatur(alistitem: Tlistitem);
begin
setDecimalSeparator('.')
if wrec.temp <> '' then begin
if trunc(strtofloat(wrec.temp)) < 5 then
alistitem.imageindex:= random(1)+2;
if trunc(strtofloat(wrec.temp)) < 2 then
alistitem.imageindex:= 3;
if (trunc(strtofloat(wrec.temp)) >= 5) and (trunc(strtofloat(wrec.temp)) <= 10) then
alistitem.imageindex:= 1;
if trunc(strtofloat(wrec.temp)) >= 11 then
alistitem.imageindex:= 0;
if wrec.descript= 'Rain' then
alistitem.imageindex:= 2;
if wrec.descript= 'Thunderstorm' then
alistitem.imageindex:= 2;
if wrec.descript= 'Clouds' then
alistitem.imageindex:= 1;
if wrec.descript= 'Drizzle' then
alistitem.imageindex:= 1;
if wrec.descript= 'Mist' then
alistitem.imageindex:= 1;
if wrec.descript= 'Snow' then
alistitem.imageindex:= 3;
if wrec.descript= 'Haze' then
alistitem.imageindex:= random(1)+1;
end;
end;
procedure SetImageTemperaturPredict(alistitem: Tlistitem; aicon: string);
begin
setDecimalSeparator('.')
case aicon of
'01d','01n': alistitem.imageindex:= 0; '04d','04n','03n','02n','02d': alistitem.imageindex:= 1; '10n','10d': alistitem.imageindex:= 2; '13d','13n': alistitem.imageindex:= 3; else alistitem.imageindex:= random(1)+1;
end;
end;
procedure CheckBitmapIcons;
begin
if not fileExists(exepath+'WeatherImageList.dat') then begin
wGetX2('http://www.kleiner.ch/images/weatherimagelist.txt',
exepath+'WeatherImageList.dat');
ShowmessageBig('second download starts..., please confirm!')
wGetX2('http://www.kleiner.ch/images/weatherimagelist1.txt',
exepath+'WeatherImageList1.dat');
end;
writeln('imagelist *.dat has been downloaded at: ' +exepath)
end;
Procedure loadForm;
var tB: TTrackBar;
NewColumn: TListColumn;
atool: TToolBar;
asr: AnsiString;
ListItem: TListItem;
image, image1, image2, image3: TBitmap;
sunr, suns: string;
begin
setupAnimation;
aFrm:= TForm.Create(self);
with aFrm do begin
Caption:= '********** maXbox Weather Station7 Map: type new+york for 2 names find ***********';
height:= 660;
width:= 930;
Position:= poScreenCenter;
formstyle:= fsstayontop;
Icon.LoadFromResourceName(HInstance,'MOON'); onClose:= @TFrm1_closeForm;
Canvas.Pen.color:= clBlue;
Canvas.Pen.Width:= 15;
BorderIcons:= [biSystemMenu, biMinimize];
BorderStyle:= bsSingle;
scaled:= true;
autoscroll:= true;
onMouseDown:= @FormMouseDown;
Show;
end;
with TBitBtn.Create(aFrm) do begin
Parent:= aFrm;
setbounds(560,520,170,65);
caption:= '&Update';
font.size:= 15;
glyph.LoadFromResourceName(getHINSTANCE,'CL_MPPAUSE');
mXButton(02,02,width, height,15,15,handle);
onClick:= @TFrm_UpdateClick;
end;
with TBitBtn.Create(aFrm) do begin
Parent:= aFrm;
setbounds(380,520,170,65);
caption:= '&Forecast';
font.size:= 15;
glyph.LoadFromResourceName(getHINSTANCE,'VPDOTS'); mXButton(02,02,width, height,15,15,handle);
onClick:= @TFrm_ForecastClick;
end;
with TBitBtn.Create(aFrm) do begin
Parent:= aFrm;
setbounds(740,520,170,65);
caption:= '&Close';
font.size:= 15;
glyph.LoadFromResourceName(getHINSTANCE,'CL_MPSTOP');
mXButton(02,02,width, height,15,15,handle);
onClick:= @TFrm1_CloseClick;
end;
tB:= TTrackBar.create(aFrm);
with tB do begin
parent:= aFrm;
setBounds(40,515,230,70);
Min:= 10; Max:= 100
Frequency:= 10
Position:= 1000 div 50;
linesize:= 15;
ThumbLength:= 55;
SetFocus;
OnChange:= @TFrm1_trackSpeedChange;
end;
statbar1:= TStatusBar.Create(aFrm);
with statbar1 do begin
parent:= aFrm;
showhint:= true;
parentcolor:= false;
color:= clred;
hint:= 'this is a Weather LED BoX in maXcalc';
Panels.add;
panels.items[0].width:= 200;
panels.items[0].text:= DateTimeToInternetStr(Now, true);
Panels.add;
panels.items[1].width:= 150;
panels.items[1].text:= '150 get the solution';
end;
atool:= TToolBar.create(aFrm);
imagelist1:= TCustomImageList.Create(NIL);
ReadComponentResFile(exepath+'WeatherImageList1.dat', imagelist1);
with imagelist1 do begin
Height:= 39; Width:= 39;
Add(image,NIL);
Add(image1,NIL);
Add(image2,NIL);
end;
imagelist2:= TCustomImageList.Create(aFrm);
ReadComponentResFile(exepath+'WeatherImageList.dat',imagelist2);
with imagelist2 do begin
Height:= 39; Width:= 39;
Add(image,NIL);
Add(image1,NIL);
Add(image2,NIL);
Add(image3,NIL);
end;
with atool do begin
setBounds(10,5,100,80)
Parent:= aFrm;
parentcolor:= false;
ButtonHeight:= 50;
ButtonWidth:= 90;
EdgeInner:= esNone;
EdgeOuter:= esNone;
Flat:= True;
HotImages:= ImageList1;
Images:= ImageList2;
ShowCaptions:= True;
color:= clnavy;
Transparent:= True;
show;
end;
with TToolbutton.create(atool) do begin
parent:= atool;
Caption:= '&Open';
ImageIndex:= 2;
ShowHint:= False
OnClick:= @OpenWeatherList;
end;
with TToolbutton.create(atool) do begin
parent:= atool;
Caption:= '&Add';
ImageIndex:= 1;
ShowHint:= False
OnClick:= @TFrm1_AddClick
end;
with TToolbutton.create(atool) do begin
parent:= atool;
Caption:= '&Scan';
ImageIndex:= 0;
OnClick:= @tbtnScanClick
end;
myEdit:= TEdit.create(aFrm);
with myEdit do begin
parent:= afrm;
text:= ' Klagenfurt';
borderstyle:= bsnone;
setbounds(212,10,250,32);
color:= clweblightblue; font.color:= clwebdarkred; font.size:= 18;
onkeypress:= @Edit1KeyPress;
show
end;
with TColorBox.create(self) do begin
parent:= aFrm;
top:= 10;
left:= 488;
width:= 263;
height:= 50;
items[16];
font.size:= 14;
onclick:= @TFrm_color1Click;
Show;
end;
DecodeTime(now,hh,mm,ss,ms);
progbar:= TProgressbar.create(afrm);
with progbar do begin
parent:= aFrm;
Align:= albottom;
Max:= (24*60);
position:= tb.position;
Position:= (hh * 60)+mm;
Brush.Color := clTeal;
SendMessage(Handle, PBM_SETBARCOLOR, 0, clYellow);
end;
view:= TListview.create(aFrm);
with view do begin
parent:= aFrm;
setbounds(10,65,910,435)
DoubleBuffered:= False
FlatScrollBars:= True
readonly:= false;
gridLines:= true;
RowSelect:= True;
NewColumn:= Columns.Add;
NewColumn.Caption:= 'City:Country';
newColumn.width:= 245;
newcolumn.alignment:= taLeftJustify;
NewColumn:= Columns.add;
NewColumn.Caption:= 'Weather Sensor';
newColumn.width:= 420;
NewColumn:= Columns.add;
NewColumn.Caption:= 'Description';
newColumn.width:= 180;
NewColumn:= Columns.add;
NewColumn.Caption:= 'FCast';
newColumn.width:= 60;
HotTrack:= True;
HotTrackStyles:= [htHandPoint];
RowSelect:= True;
hint:= 'Dblclick for Satellite Map';
ShowHint:= True;
font.size:= 14
SmallImages:= ImageList2;
ListView_SetTextBkColor(view.handle, $8deeed) ondblclick:= @listclick;
onmousedown:= @listclick2;
onkeypress:= @edit1KeyPress;
viewstyle:= vsreport;
readonly:= false;
ListItem:= view.Items.Add;
ListItem.Caption:= '801 Cologne';
ListItem.SubItems.Add('Add a new city or town to the list');
ListItem.SubItems.Add('mX 4.7.6.20');
items[0].EditCaption;
if isInternet then begin
sr:= GetGeoWeather('kiruna', UrlWeatherReport25);
getMultipleWeather(sr)
ListItem:= view.Items.Add;
SetImageTemperatur(listitem)
AddlistItem(listitem)
writeln(sr)
sr:= GetGeoWeather('trieste', UrlWeatherReport25);
getMultipleWeather(sr)
ListItem:= view.Items.Add;
SetImageTemperatur(listitem)
AddlistItem(listitem)
writeln(sr)
sr:= GetGeoWeather('koeln', UrlWeatherReport25);
getMultipleWeather(sr)
ListItem:= view.Items.Add;
SetImageTemperatur(listitem)
AddlistItem(listitem)
writeln(sr)
getMultipleWeather(GetGeoWeather('klagenfurt', UrlWeatherReport25))
ListItem:= view.Items.Add;
SetImageTemperatur(listitem)
AddlistItem(listitem)
ListView_SetTextBkColor(view.handle, $7dcced) writeln(sr)
getMultipleWeather(GetGeoWeather('paris', UrlWeatherReport25))
ListItem:= view.Items.Add;
SetImageTemperatur(listitem)
AddlistItem(listitem)
sr:= GetGeoWeather('bern', UrlWeatherReport25);
getMultipleWeather(GetGeoWeather('bern', UrlWeatherReport25))
ListItem:= view.Items.Add;
SetImageTemperatur(listitem)
AddlistItem(listitem)
writeln('bern sunsettest: '+sr)
writeln(copy(sr, pos('sunrise":',sr)+9,10))
sunr:= copy(sr, pos('sunrise":',sr)+9,10);
writeln('bern sunrise: '
+datetimetostr(UnixDateTimeToDelphiDateTime(strtoint(sunr))))
suns:= copy(sr, pos('sunset":',sr)+8,10);
writeln('bern sunset: '
+datetimetostr(UnixDateTimeToDelphiDateTime(strtoint(suns))))
getMultipleWeather(GetGeoWeather('stockholm', UrlWeatherReport25))
ListItem:= view.Items.Add;
SetImageTemperatur(listitem)
AddlistItem(listitem)
getMultipleWeather(GetGeoWeather('havana', UrlWeatherReport25))
ListItem:= view.Items.Add;
SetImageTemperatur(listitem)
AddlistItem(listitem)
getMultipleWeather(GetGeoWeather('brussels', UrlWeatherReport25))
ListItem:= view.Items.Add;
SetImageTemperatur(listitem)
AddlistItem(listitem)
statbar1.panels.items[1].text:= sr;
statbar1.hint:= sr;
end else begin
getMultipleWeather(jsonstr)
ListItem:= view.Items.Add;
with ListItem do begin
Caption:= wrec.id+' '+wrec.city;
SubItems.Add(wrec.temp+' ° temp bar: '+wrec.bar+' of humid: '+wrec.humid+'%');
SubItems.Add(wrec.descript);
imageindex:= 2
end;
statbar1.panels.items[1].text:= jsonstr;
statbar1.hint:= jsonstr;
asr:= ansistring(getbigpi);
end;
end;
end;
Procedure loadPredictForm;
var NewColumn: TListColumn;
asr: AnsiString;
ListItem: TListItem;
begin
aPFrm:= TForm.Create(self);
with aPFrm do begin
Caption:= '********** maXbox Weather Station6 Forecaster ***********';
height:= 730; width:= 980;
Position:= poScreenCenter;
formstyle:= fsstayontop;
Icon.LoadFromResourceName(HInstance,'ZHISTOGRAM'); onClose:= @TFrm2_closeForm;
Canvas.Pen.color:= clBlue;
Canvas.Pen.Width:= 10;
BorderIcons:= [biSystemMenu, biMinimize];
BorderStyle:= bsSingle;
scaled:= true;
autoscroll:= true;
Show;
end;
pview:= TListview.create(aFrm);
with pview do begin
parent:= aPFrm;
setbounds(10,15,940,660)
DoubleBuffered:= False
FlatScrollBars:= True
readonly:= false;
gridLines:= true;
RowSelect:= True;
NewColumn:= Columns.Add;
NewColumn.Caption:= 'City:Country';
newColumn.width:= 140;
newcolumn.alignment:= taLeftJustify;
NewColumn:= Columns.add;
NewColumn.Caption:= 'Weather Forecast Sensor';
newColumn.width:= 515;
NewColumn:= Columns.add;
NewColumn.Caption:= 'Description';
newColumn.width:= 200;
NewColumn:= Columns.add;
NewColumn.Caption:= 'TFCast';
newColumn.width:= 60;
onmousedown:= @listclickpredict;
HotTrack:= True;
HotTrackStyles:= [htHandPoint];
RowSelect:= True;
hint:= 'Dblclick for Detail Map';
ShowHint:= True;
font.size:= 10
SmallImages:= ImageList2;
ListView_SetTextBkColor(pview.handle, $8deeed)
viewstyle:= vsreport;
readonly:= false;
ListItem:= pview.Items.Add;
ListItem.Caption:= '801 Forecast List Line';
ListItem.SubItems.Add('Add a new city or town to the list');
ListItem.SubItems.Add('mX 4.7.6.20');
items[0].EditCaption;
end;
statbar2:= TStatusBar.Create(apFrm);
with statbar2 do begin
simplepanel:= false;
parent:= apFrm;
showhint:= true;
parentcolor:= false;
color:= clred;
hint:= 'this is a Weather Forecast in maXcalc';
Panels.add;
panels.items[0].width:= 200;
panels.items[0].text:= DateTimeToInternetStr(Now, true);
Panels.add;
panels.items[1].width:= 150;
panels.items[1].text:= '150 get the forecaster solution';
end;
if isInternet then begin
sr:= GetGeoWeather('kiruna', UrlWeatherReport25);
getMultipleWeather(sr)
ListItem:= pview.Items.Add;
SetImageTemperatur(listitem)
AddlistItem(listitem)
writeln(sr)
sr:= GetGeoWeather('trieste', UrlWeatherReport25);
getMultipleWeather(sr)
ListItem:= pview.Items.Add;
SetImageTemperatur(listitem)
AddlistItem(listitem)
writeln(sr)
end else begin
getMultipleWeather(jsonstr)
ListItem:= pview.Items.Add;
with ListItem do begin
Caption:= wrec.id+' '+wrec.city;
SubItems.Add(wrec.temp+' ° temp bar: '+wrec.bar+' of humid: '+wrec.humid+'%');
SubItems.Add(wrec.descript);
imageindex:= 2
end;
statbar2.hint:= pview.hint; end;
statbar2.hint:= pview.hint
end;
Procedure sunrisesetRouter(lon, lat: float);
var rs: TSTRiseSetRec;
UT: TSTDateTimeRec; iday: TDateTime;
begin
UT.D:= currentdate;
UT.T:= currenttime;
iday:= date;
iday:= adddays(iday,1);
writeln(sttimetotimestring('hh:mm',UT.T,false))
for it:= 0 to 25 do begin
ut.d:= stincdate(ut.d, it,0,0);
rs:= sunriseset(UT.d, lon, lat);
with rs do begin
if orise >-1 then
writeln('sunrise of '+stdatetodatestring('dd.mm.yyyy',ut.d,false)+' : '
+#9+sttimetotimestring('hh:mm',
orise, false)+#9+ ' sunSet: '+
sttimetotimestring('hh:mm', oset, false));
end;
end;
end;
var UserSpaceAvail, TotalSpaceAvail, DiskSize: Comp; begin initTabletmode;
CheckBitmapIcons;
if not InitGraphics(950, 310) then begin
Writeln('Unable to set stat graphic mode');
end; loadForm;
if decimalseparator <> '.' then
showmessageBig('you might have a decimal problem - we help you to switch to .');
writeln('decimalseparator: '+decimalseparator)
setdecimalseparator('.')
with maxform1 do begin
with memo2 do begin
color:= clblack;
font.color:= clweborange;
font.size:= 16;
end;
end;
if GetDiskSpace('C',UserSpaceAvail,TotalSpaceAvail,DiskSize) then
printF('UserSpaceAvail: %d TotalSpaceAvail: %d DiskSize: %d',
[UserSpaceAvail div 1024,TotalSpaceAvail div 1024,DiskSize div 1024]);
with TClientSocket.create(self) do begin
writeln('TCustomWinSocket host: '+TCustomWinSocket(Socket).remotehost);
writeln('TCustomWinSocket port: '+intToStr(TCustomWinSocket(Socket).remoteport));
Free
end;
writeln(itoa((hh * 60)+mm))
writeln('köln time: '+datetimetostr(UnixDateTimeToDelphiDateTime(1446127190)))
writeln('havana time: '+datetimetostr(UnixDateTimeToDelphiDateTime(1446125586)))
writeln('Sunriseset table of Bern, CH')
sunrisesetRouter(7.45,46.95);
if isInternet then begin
writeln('GetRealIP2_string: '+GetRealIP2)
writeln('Weather Report date: '+DateTimeToInternetStr(now, true))
write('Local Weather Sensor: '+localcity+' '+localcountry)
sr:= GetGeoWeather(localcity+','+localcountry, UrlWeatherReport25);
getMultipleWeather(sr)
if localcity <> '' then
myedit.text:= localcity+','+localcountry else
myedit.text:= ' Klagenfurt';
end;
zoomf:= 16;
raiselastwin32;
print(getAscii) End.
--------------------------------------------------------------------------------
Doc: https:var
aFrm: TForm;
mT: TTimer;
tB: TTrackBar;
statBar1: TStatusBar;
http:procedure loadForm;
var tB: TTrackBar;
begin
aFrm:= TForm.Create(self);
with aFrm do begin
Caption:= '********** Form Template ***********';
height:= 510;
width:= 700;
Position:= poScreenCenter;
onClose:= @TFrm1_closeForm;
Canvas.Pen.color:= clBlue;
Canvas.Pen.Width:= 15;
BorderIcons = [biSystemMenu, biMinimize]
BorderStyle = bsSingle
Show;
canvas.brush.bitmap:= getBitmapObject(Exepath+'examples\images\bmp47.bmp');
Canvas.FillRect(Rect(600,300,100,100));
end;
with TBitBtn.Create(aFrm) do begin
Parent:= aFrm;
setbounds(310,390,150,55);
caption:= 'Pause';
font.size:= 12;
glyph.LoadFromResourceName(getHINSTANCE,'CL_MPPAUSE');
mXButton(05,05,width, height,12,12,handle);
onClick:= @TFrm1_PauseClick;
end;
with TBitBtn.Create(aFrm) do begin
Parent:= aFrm;
setbounds(490,390,150, 55);
caption:= 'Close';
font.size:= 12;
glyph.LoadFromResourceName(getHINSTANCE,'CL_MPSTOP');
mXButton(05,05,width, height,12,12,handle);
onClick:= @TFrm1_CloseClick;
end;
tB:= TTrackBar.create(aFrm);
with tB do begin
parent:= aFrm;
setBounds(40,402,230,40);
Min:= 10; Max:= 100
Frequency:= 10
Position:= 1000 div 50;
linesize:= 4;
ThumbLength:= 30;
SetFocus;
OnChange:= @TFrm1_trackSpeedChange;
end;
statbar1:= TStatusBar.Create(aFrm);
with statbar1 do begin
parent:= aFrm;
showhint:= true;
hint:= 'this is a LED BoX';
Panels.add;
panels.items[0].width:= 200;
panels.items[0].text:= '200';
Panels.add;
panels.items[1].width:= 150;
panels.items[1].text:= '150';
end;
end;
object mainForm1: TmainForm1
Left = 227
Top = 124
HelpContext = 1
BorderIcons = [biSystemMenu, biMinimize]
BorderStyle = bsSingle
BorderWidth = 1
Caption = 'maTRIx by maX'
ClientHeight = 501
ClientWidth = 746
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
Menu = MainMenu1
OldCreateOrder = False
Position = poDesktopCenter
Scaled = False
OnActivate = FormActivate
OnCreate = FormCreate
OnDestroy = FormDestroy
PixelsPerInch = 96
TextHeight = 13
object Splitter1: TSplitter
Left = 177
Top = 41
Width = 2
Height = 421
Cursor = crHSplit
ResizeStyle = rsLine
end
object StatusBar1: TStatusBar
Left = 0
Top = 482
Width = 746
Height = 19
Panels = <>
SimplePanel = True
SimpleText = 'StatusLine: OK'
SizeGrip = False
end
object CoolBar1: TCoolBar
Left = 0
Top = 0
Width = 746
Height = 41
Bands = <
item
object ToolBar1: TToolBar
Left = 9
Top = 0
Width = 729
Height = 49
Align = alClient
ButtonHeight = 36
ButtonWidth = 69
EdgeInner = esNone
EdgeOuter = esNone
Flat = True
HotImages = ImageList1
Images = ImageList2
ShowCaptions = True
TabOrder = 0
Transparent = True
object tbtnClose: TToolButton
Left = 0
Top = 0
Caption = '&Close'
ImageIndex = 1
ParentShowHint = False
ShowHint = False
OnClick = tbtnCloseClick
end
object ToolButton2: TToolButton
Left = 69
Top = 0
Width = 8
Caption = 'ToolButton2'
ImageIndex = 1
Style = tbsSeparator
end
object tbtnGenerator: TToolButton
Left = 77
Top = 0
Caption = '&Generator'
ImageIndex = 2
OnClick = MovingAverage1Click
end
object tbtnOptions: TToolButton
Left = 146
Top = 0
Caption = '&Options'
ImageIndex = 3
Style = tbsCheck
OnClick = tbtnOptionsClick
end
object tbtnTrans: TToolButton
Left = 215
Top = 0
Caption = '&Transaction'
ImageIndex = 0
OnClick = tbtnTransClick
end
object ToolButton5: TToolButton
Left = 284
Top = 0
Width = 13
Caption = 'ToolButton5'
ImageIndex = 3
Style = tbsSeparator
end
end
end
object progBar: TProgressBar
Left = 0
Top = 462
Width = 746
Height = 20
Align = alBottom
Min = 0
Max = 100
Smooth = True
TabOrder = 2
Visible = False
end
object TreeView1: TTreeView
Left = 0
Top = 41
Width = 177
Height = 421
Align = alLeft
AutoExpand = True
Images = ImageList4
Indent = 19
ReadOnly = True
TabOrder = 3
OnChange = TreeView1Change
end
object view: TListView
Left = 179
Top = 41
Width = 567
Height = 421
Align = alClient
Columns = <
item
AutoSize = True
Caption = 'Content'
ImageIndex = 3
end>
HotTrack = True
HotTrackStyles = [htHandPoint]
IconOptions.AutoArrange = True
RowSelect = True
ParentShowHint = False
ShowHint = True
SmallImages = ImageList5
StateImages = ImageList5
TabOrder = 4
ViewStyle = vsReport
OnClick = viewClick
end
object MainMenu1: TMainMenu
Left = 240
Top = 136
object Datei1: TMenuItem
Caption = '&File'
object mnOpentree: TMenuItem
Caption = '&Open Tree'
OnClick = mnOpentreeClick
end
object Beenden1: TMenuItem
Caption = '&Close'
OnClick = tbtnCloseClick
end
end
object Registry1: TMenuItem
Caption = '&Tools'
object Fractals: TMenuItem
Caption = 'Fractals...'
OnClick = FractalsClick
end
object Generator: TMenuItem
Caption = '&Chart Generator...'
OnClick = MovingAverage1Click
end
object Verschlsseln1: TMenuItem
Caption = '&Encrypt/ Decrypt'
object mnEncrypt: TMenuItem
Caption = '&Encrypt'
OnClick = mnEncryptClick
end
object mnDecrypt: TMenuItem
Caption = '&Decrypt'
OnClick = mnDecryptClick
end
end
object MATestCase1: TMenuItem
Caption = 'MA TestCase'
OnClick = MATestCase1Click
end
object mnSearch: TMenuItem
Caption = '&Search in Memo'
OnClick = mnSearchClick
end
object mnRegistryReader: TMenuItem
Caption = '&Registry Reader'
object r1: TMenuItem
Caption = 'Run'
OnClick = r1Click
end
object r2: TMenuItem
Caption = 'RunOnce'
OnClick = r2Click
end
object R3: TMenuItem
Caption = 'RunOnceEX'
OnClick = R3Click
end
object R4: TMenuItem
Caption = 'RunServices'
OnClick = R4Click
end
object R5: TMenuItem
Caption = 'RunServicesOnce'
OnClick = R5Click
end
object T1: TMenuItem
Caption = 'TypedURLs'
OnClick = T1Click
end
end
end
object info1: TMenuItem
Caption = '&Info'
OnClick = info1Click
object options: TMenuItem
Caption = '&Options'
OnClick = tbtnOptionsClick
end
end
end
object ImageList1: TImageList
Left = 504
Top = 72
object ImageList3: TImageList
Left = 196
Top = 210
The set of APIs within a device family is broken down into subdivisions known as API contracts. See Device families.
This reference topic enumerates for Windows 10 all of the API contracts and their versions, with links to the and the APIs within each, with links to topics with more info on each particular API contract.
http:http:https:GetRealIP2_string: Weather Report date: Fri, 18 Dec 2015 10:50:16 +0100
Local Weather Sensor: Tann CH
Weather Id:802 is Clouds in: Tann at 6.35 of 1027 pressure with 100% humidity
http:Havana, La Habana, Cuba | 23° 7' 48"N, 82° 23' 24"W
coord of Havana :CU : -82.36 23.14
Cologne, North Rhine-Westphalia, Germany | 50.95°N, 6.97°E
coord of Koeln :DE : 6.96 50.94
http:Klagenfurt, Carinthia, Austria | 46.62°N, 14.31°E
coord of Klagenfurt :AT : 46.62 14.31
https: