KodeZwerg

Pascal is dead - long live pascal!

You should contact them, here you will not find/get the installation files. To write an email you do not need to have an account over there.

Nope, by looking at the first four Bytes it really looks like a Jpeg signature, at least they start same way, but why an image file got a .pas extension... ask @georges pletinckx So I hope for him he still got a backup somewhere flying around.

I've added a very basic example project in hope that I've understand correct what you try to achieve. Here are my basics shown as code: procedure TForm1.btnStartClick(Sender: TObject); begin FSec := SpinEdit1.Value; lblTime.Caption := IntToStr(FSec); Timer1.Enabled := True; btnPause.Enabled := True; btnStop.Enabled := True; btnStart.Enabled := False; end; procedure TForm1.btnPauseClick(Sender: TObject); begin Timer1.Enabled := (not Timer1.Enabled); end; procedure TForm1.btnStopClick(Sender: TObject); begin btnPause.Enabled := False; btnStop.Enabled := False; btnStart.Enabled := True; Timer1.Enabled := False; end; procedure TForm1.Timer1Timer(Sender: TObject); begin if (FSec > 0) then begin Dec(FSec, 1); lblTime.Caption := IntToStr(FSec); end else begin lblTime.Caption := IntToStr(FSec); Timer1.Enabled := False; btnPause.Enabled := False; btnStop.Enabled := False; btnStart.Enabled := True; end; end; (above code is slighty updated, attached archive does not contain latest modification from above) timerStopwatch.zip

Beside the WinAPI way, you could make your day easier by following the Vcl way of doing and playing with the Titlebar.

If you need options in more than one unit, I would create a record or class in a seperate unit called "uConfig" or something like that, add to your class/record everything that your app needs to be set up, add load and save methods to that class/record. Make that class/record global available inside the "interface" part. Maybe use "initialization" to auto fill record/class with data and "finalization" to free it again if its a class.

Added a small demo. Does it work, show and demonstrate what you try to do? IniExample.zip

var a, b, c: Double; begin try a := 66.3333; b := 1.5; c := a * b; WriteLn(FloatToStrF(c, ffFixed, 16, 5)); ReadLn; except on E: Exception do Writeln(E.ClassName, ': ', E.Message); end; end. Output: 99,49995

And what exactly is your problem?

Somewhere I've done a mistake, when I remove the "halt" app going into a deadlock.

Maybe this helps you as it helped me. That method looks if property is available and set it. uses TypInfo, Rtti; function SetProperty(const AControl: TControl; const AProperty: string; const AValue: TValue): Boolean; var LControl: TControl; LRttiContext: TRttiContext; LRttiProperty: TRttiProperty; begin Result := False; try LControl := AControl; LRttiProperty := LRttiContext.GetType(LControl.ClassType).GetProperty(AProperty); if ((LRttiProperty <> nil) and (LRttiProperty.Visibility in [mvPrivate, mvProtected, mvPublic, mvPublished])) then begin LRttiProperty.SetValue(LControl, AValue); Result := True; end; except end; end; and it can be used like: SetProperty(AControl, 'Caption', AValue);

Coding non-Vcl is a good way to learn how things are working under the Vcl. (beside the benefit that the compiled file is just around 50kb vs 3mb by using Vcl)

If that is your only observation than you should re-read and re-compare what I am doing and what you are doing.

Here is a full example, excuse any errors, long time not done non-vcl 😛 program BitmapDemo; {$APPTYPE GUI} {.$R *.res} uses Winapi.Windows, Winapi.Messages; const GClassName: string = 'KodeZwergs_CLASS'; GWidth: Integer = 800; GHeight: Integer = 600; var LWinClass: TWndClass; LInst: HINST; LHWND, LBitmap: HWND; LMsg: TMsg; LBmp: HBITMAP; function WindowProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; var s: string; ws: WideString; begin case Msg of WM_DESTROY: begin UnregisterClass(PChar(GClassName), LInst); PostQuitMessage(0); Halt; end; else Result := DefWindowProc(hWnd, Msg, wParam, lParam); end; end; procedure CreateClient; begin LInst := GetModuleHandle(nil); with LWinClass do begin style := CS_CLASSDC or CS_PARENTDC or CS_HREDRAW or CS_VREDRAW; lpfnWndProc := @WindowProc; cbClsExtra := 0; cbWndExtra := 0; hInstance := LInst; hIcon := LoadIcon(hInstance, PChar('MAINICON')); hCursor := LoadCursor(0, PChar(IDC_ARROW)); hbrBackground := Succ(COLOR_BTNFACE); lpszMenuName := PChar(''); lpszClassname := PChar(GClassName); end; RegisterClass(LWinClass); LHWND := CreateWindowEx(WS_EX_WINDOWEDGE or WS_EX_TOPMOST, PChar(GClassName), PChar('KodeZwergs Bitmap Example'), DS_CENTER OR WS_VISIBLE or WS_CAPTION or WS_POPUP or WS_SYSMENU or WS_BORDER, ((GetSystemMetrics(SM_CXFULLSCREEN) div 2) - (GWidth div 2)), ((GetSystemMetrics(SM_CYFULLSCREEN) div 2) - ((GHeight - (GetSystemMetrics(SM_CYSIZE) + GetSystemMetrics(SM_CYMIN))) div 2)), GWidth, GHeight + GetSystemMetrics(SM_CYSIZE), 0, 0, LInst, NIL); if (LHWND = 0) then begin UnregisterClass(PChar(GClassName), LInst); Exit; end; // create static for bitmap LBitmap := CreateWindow('Static', '', SS_BITMAP or WS_CHILD or WS_VISIBLE or WS_GROUP, 5, 5, (GWidth - 5), (GHeight - 5), LHWND, 0, LInst, NIL); // load bitmap LBmp := LoadImage(LInst, PChar('.\Bitmap.bmp'), IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE); // display bitmap SendMessage(LBitmap, STM_SETIMAGE, IMAGE_BITMAP, LBmp); end; procedure RunClient; begin UpdateWindow(LHWND); while(GetMessage(LMsg, LHWND, 0, 0)) do begin TranslateMessage(LMsg); DispatchMessage(LMsg); end; UnregisterClass(PChar(GClassName), LInst); end; begin CreateClient; RunClient; end.

Not just a procedure, many things are wrong or looking strange at your code. Exemplary: procedure RunClient; begin UpdateWindow(LHWND); while(GetMessage(LMsg, LHWND, 0, 0)) do begin TranslateMessage(LMsg); DispatchMessage(LMsg); end; UnregisterClassA(PChar(GClassName), LInst); end; A message loop.... (mostest basic things for non-Vcl code) You really should structure your whole code better, making methods for each thing etc....

Does ATBinHex fit your needs?

You should not use requireAdministrator for that reason, it is better to just elevate when needed. You can find a very useful unit that provide such mechanism on StackOverflow.

You are welcomed, I just tried to show you a way that always work, no matter what manifest (or none at all) you have, since the normal ways are able to not tell you the truth.

or refactor source to always use real version like exemplary here shown: type TTrueVersion = packed record Major, Minor, Build: DWORD; end; procedure RtlGetNtVersionNumbers(out MajorVersion, MinorVersion, BuildNumber: DWORD); stdcall; external 'Ntdll.dll'; function GetTrueVersion: TTrueVersion; var vMaj, vMin, vBuild: DWORD; begin RtlGetNtVersionNumbers(vMaj, vMin, vBuild); Result.Major := vMaj; Result.Minor := vMin; Result.Build := Lo(vBuild); end; procedure TForm1.FormCreate(Sender: TObject); var ver: TTrueVersion; begin ver := GetTrueVersion; Label1.Caption := Format('Running Windows %d.%d Build: %d', [ver.Major, ver.Minor, ver.Build]); end;

For me this works flawless: unit uMain; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Menus, Vcl.Themes, System.IniFiles; type TfrmMain = class(TForm) mmMain: TMainMenu; miVcl: TMenuItem; procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure FormCreate(Sender: TObject); strict private FMenuItem: TMenuItem; private procedure AddNativeStyle(const AMenuItem: TMenuItem); public procedure NativeStyleClick(Sender: TObject); end; var frmMain: TfrmMain; implementation {$R *.dfm} procedure TfrmMain.FormCreate(Sender: TObject); var ini: TIniFile; fn: string; Stylename: string; i: Integer; begin AddNativeStyle(miVcl); fn := ChangeFileExt(ParamStr(0), '.ini'); ini := TIniFile.Create(fn); try Stylename := ini.ReadString('Options', 'Theme', 'Windows'); for i := 0 to Pred(miVcl.Count) do if StripHotkey(miVcl.Items[i].Caption) <> Stylename then miVcl.Items[i].Checked := False else miVcl.Items[i].Checked := True; TStyleManager.TrySetStyle(StyleName, True); finally ini.Free; end; end; procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction); var ini: TIniFile; fn: string; i: Integer; StyleName: String; begin fn := ChangeFileExt(ParamStr(0), '.ini'); ini := TIniFile.Create(fn); try for i := 0 to Pred(miVcl.Count) do if miVcl.Items[i].Checked then begin StyleName := StripHotkey(miVcl.Items[i].Caption); Break; end; ini.WriteString('Options', 'Theme', StyleName); finally ini.Free; end; end; procedure TfrmMain.AddNativeStyle(const AMenuItem: TMenuItem); procedure AddMenuEntry(const ACaption: string; const AValue: Integer); var Item: TMenuItem; begin Item := TMenuItem.Create(FMenuItem); Item.Caption := ACaption; Item.OnClick := NativeStyleClick; Item.AutoCheck := False; Item.RadioItem := False; Item.Checked := TStyleManager.ActiveStyle.Name = ACaption; if ((AValue) mod 50) = 0 then Item.Break := mbBarBreak; FMenuItem.Add(Item); end; var Arr: TArray<string>; SystemStyle: string; FoundStyle: String; i: Integer; begin FMenuItem := AMenuItem; FMenuItem.Clear; FMenuItem.AutoLineReduction := maAutomatic; Arr := TStyleManager.StyleNames; SystemStyle := TStyleManager.SystemStyle.Name; AddMenuEntry(SystemStyle, 0); i := 1; for FoundStyle in Arr do begin if FoundStyle <> SystemStyle then begin AddMenuEntry(FoundStyle, i); Inc(i); end; end; end; procedure TfrmMain.NativeStyleClick(Sender: TObject); var StyleName: String; i: Integer; begin StyleName := StripHotkey((Sender as TMenuItem).Caption); TStyleManager.TrySetStyle(StyleName, True); (Sender as TMenuItem).Checked := True; for i := 0 to Pred(FMenuItem.Count) do if (not FMenuItem.Items[i].Equals(Sender)) then FMenuItem.Items[i].Checked := False; end; end. Tested with Alexandria 11.2

Than not save, make it a string or whatever you need, as file is just for demo reasons. @Zazhir

If your current problem is just that you can not download a file, with the Windows API it works like shown: program Project11; {$APPTYPE CONSOLE} {$R *.res} uses Winapi.Windows, Winapi.WinInet, System.SysUtils; const oneKB = DWORD(1024); procedure ParseURL(const lpszUrl: string; var Host, Resource: string); var lpszScheme : array[0..Pred(INTERNET_MAX_SCHEME_LENGTH)] of Char; lpszHostName : array[0..Pred(INTERNET_MAX_HOST_NAME_LENGTH)] of Char; lpszUserName : array[0..Pred(INTERNET_MAX_USER_NAME_LENGTH)] of Char; lpszPassword : array[0..Pred(INTERNET_MAX_PASSWORD_LENGTH)] of Char; lpszUrlPath : array[0..Pred(INTERNET_MAX_PATH_LENGTH)] of Char; lpszExtraInfo : array[0..Pred(oneKB)] of Char; lpUrlComponents : TURLComponents; begin ZeroMemory(@lpszScheme, SizeOf(lpszScheme)); ZeroMemory(@lpszHostName, SizeOf(lpszHostName)); ZeroMemory(@lpszUserName, SizeOf(lpszUserName)); ZeroMemory(@lpszPassword, SizeOf(lpszPassword)); ZeroMemory(@lpszUrlPath, SizeOf(lpszUrlPath)); ZeroMemory(@lpszExtraInfo, SizeOf(lpszExtraInfo)); ZeroMemory(@lpUrlComponents, SizeOf(TURLComponents)); lpUrlComponents.dwStructSize := SizeOf(TURLComponents); lpUrlComponents.lpszScheme := lpszScheme; lpUrlComponents.dwSchemeLength := SizeOf(lpszScheme); lpUrlComponents.lpszHostName := lpszHostName; lpUrlComponents.dwHostNameLength := SizeOf(lpszHostName); lpUrlComponents.lpszUserName := lpszUserName; lpUrlComponents.dwUserNameLength := SizeOf(lpszUserName); lpUrlComponents.lpszPassword := lpszPassword; lpUrlComponents.dwPasswordLength := SizeOf(lpszPassword); lpUrlComponents.lpszUrlPath := lpszUrlPath; lpUrlComponents.dwUrlPathLength := SizeOf(lpszUrlPath); lpUrlComponents.lpszExtraInfo := lpszExtraInfo; lpUrlComponents.dwExtraInfoLength := SizeOf(lpszExtraInfo); InternetCrackUrl(PChar(lpszUrl), Length(lpszUrl), ICU_DECODE or ICU_ESCAPE, lpUrlComponents); Host := lpszHostName; Resource := lpszUrlPath; end; function GetWinInetError(ErrorCode:Cardinal): string; const winetdll = 'wininet.dll'; var Len: Integer; Buffer: PChar; begin Len := FormatMessage( FORMAT_MESSAGE_FROM_HMODULE or FORMAT_MESSAGE_FROM_SYSTEM or FORMAT_MESSAGE_ALLOCATE_BUFFER or FORMAT_MESSAGE_IGNORE_INSERTS or FORMAT_MESSAGE_ARGUMENT_ARRAY, Pointer(GetModuleHandle(winetdll)), ErrorCode, 0, @Buffer, SizeOf(Buffer), nil); try while (Len > 0) and {$IFDEF UNICODE}(CharInSet(Buffer[Len - 1], [#0..#32, '.'])) {$ELSE}(Buffer[Len - 1] in [#0..#32, '.']) {$ENDIF} do Dec(Len); SetString(Result, Buffer, Len); finally LocalFree(HLOCAL(Buffer)); end; end; function GetRemoteFileSize(const AURL: string; const AShowError: Boolean; out AFileSize: Int64): Boolean; const sUserAgent = 'Mozilla/5.001 (windows; U; NT4.0; en-US; rv:1.0) Gecko/25250101'; var hInet : HINTERNET; hConnect : HINTERNET; hRequest : HINTERNET; lpdwBufferLength: DWORD; lpdwReserved : DWORD; ServerName: string; Resource: string; ErrorCode : Cardinal; LFileSize: Int64; begin ParseURL(AUrl, ServerName, Resource); Result := False; AFileSize := -1; hInet := InternetOpen(PChar(sUserAgent), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0); if (hInet = nil) then begin ErrorCode := GetLastError; if AShowError then raise Exception.Create(Format('InternetOpen Error %d Description %s', [ErrorCode, GetWinInetError(ErrorCode)])); end; try hConnect := InternetConnect(hInet, PChar(ServerName), INTERNET_DEFAULT_HTTP_PORT, nil, nil, INTERNET_SERVICE_HTTP, 0, 0); if ((hConnect = nil) and AShowError) then begin ErrorCode := GetLastError; raise Exception.Create(Format('InternetConnect Error %d Description %s', [ErrorCode, GetWinInetError(ErrorCode)])); end; try hRequest := HttpOpenRequest(hConnect, PChar('HEAD'), PChar(Resource), nil, nil, nil, 0, 0); if (hRequest <> nil) then begin try lpdwBufferLength := SizeOf(LFileSize); lpdwReserved := 0; if ((not HttpSendRequest(hRequest, nil, 0, nil, 0)) and AShowError) then begin ErrorCode := GetLastError; raise Exception.Create(Format('HttpOpenRequest Error %d Description %s', [ErrorCode, GetWinInetError(ErrorCode)])); end; if ((not HttpQueryInfo(hRequest, HTTP_QUERY_CONTENT_LENGTH or HTTP_QUERY_FLAG_NUMBER, @LFileSize, lpdwBufferLength, lpdwReserved)) and AShowError) then begin ErrorCode := GetLastError; raise Exception.Create(Format('HttpQueryInfo Error %d Description %s', [ErrorCode, GetWinInetError(ErrorCode)])); end else begin AFileSize := LFileSize; Result := (AFileSize > 0); end; finally InternetCloseHandle(hRequest); end; end else if AShowError then begin ErrorCode := GetLastError; raise Exception.Create(Format('HttpOpenRequest Error %d Description %s', [ErrorCode, GetWinInetError(ErrorCode)])); end; finally InternetCloseHandle(hConnect); end; finally InternetCloseHandle(hInet); end; end; function Download(const AURL, AFileName: string): Boolean; const BufferSize = oneKB; var hSession, hURL: HInternet; Buffer: array[1..BufferSize] of Byte; BufferLen: DWORD; F: File; BytesLoaded, BytesTotal, BytesCalc: Int64; begin Result := False; if (not GetRemoteFileSize(AURL, True, BytesTotal)) then Exit; hSession := InternetOpen('', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0) ; // Establish the secure connection InternetConnect (hSession, PChar(AURL), INTERNET_DEFAULT_HTTPS_PORT, PChar(''), PChar(''), INTERNET_SERVICE_HTTP, 0, 0); try hURL := InternetOpenURL(hSession, PChar(AURL), nil, 0, INTERNET_FLAG_RELOAD, 0); BytesLoaded := 0; try AssignFile(f, AFileName); Rewrite(f,1); try repeat InternetReadFile(hURL, @Buffer, SizeOf(Buffer), BufferLen) ; BlockWrite(f, Buffer, BufferLen); if (BytesTotal > 0) then begin Inc(BytesLoaded, BufferLen); BytesCalc := (BytesLoaded * 100 div BytesTotal); end; until BufferLen = 0; finally CloseFile(f) ; Result := True; end; finally InternetCloseHandle(hURL); end finally InternetCloseHandle(hSession); end; end; begin try Download('https://www.receitaws.com.br/v1/cnpj/27865757000102', ExtractFilePath(ParamStr(0)) + 'file.json'); { TODO -oUser -cConsole Main : Insert code here } except on E: Exception do Writeln(E.ClassName, ': ', E.Message); end; end.

Or put logic into a dll, than you can access it from Delphi GUI or Console the same way.

Why not put the logic into its own Delphi unit/class ?