I am trying to add a menu using the case of in Pascal. I'm using pascal, what's wrong with this code statement to the case?
This is my program on pascal:
program InputNilai;
uses crt;
var
a,b,h : integer;
pilihan : char;
begin
clrscr;
write('1. Penjumlahan');
write('2. Perkalian');
write('Masukkan pilihan: '); readln(pilihan);
// menggunakan kondisi case of
case (pilihan) of
A : begin
write('Masukkan angka pertama: '); readln(a);
write('Masukkan angka kedua: '); readln(b);
h := a + b;
writeln('Result is: ',h);
end;
B : begin
write('Masukkan angka pertama: '); readln(a);
write('Masukkan angka kedua: '); readln(b);
h := a * b;
writeln('Result is ',h);
end;
else
writeln('Not valid');
end;
readln;
end.
program InputNilai;
uses crt;
var
a,b,h : integer;
pilihan : integer;
begin
clrscr;
writeln('1. Penjumlahan');
writeln('2. Perkalian');
writeln('Masukkan pilihan: ');
readln(pilihan);
// menggunakan kondisi case of
Case pilihan of
1:begin
writeln('Masukkan angka pertama: '); readln(a);
writeln('Masukkan angka kedua: '); readln(b);
h := a + b;
writeln('Result is: ',h);
end;
2:begin
writeln('Masukkan angka pertama: '); readln(a);
writeln('Masukkan angka kedua: '); readln(b);
h := a * b;
writeln('Result is ',h);
end;
else
writeln('Not valid');
end;
readln;
end.
Related
I am now developing a calculator in Pascal and I am getting this error that while the exponent is negative the result is always 0. Can someone help me with this?
Here is the piece of code for this function that I wrote so far:
5: Begin
clrscr;
Writeln('POWER');
Write('Base: ');
Readln(pot1);
Write('Exponent: ');
Readln(pot2);
res5 := 1;
if pot2 < 0 then
Begin
pot1 := 1 div pot1;
pot2 := -pot2;
res5 := 1 / res5;
End;
while pot2 > 0 do
Begin
res5 := res5 * pot1;
pot2 := pot2 - 1;
End;
Writeln('The result is: ', res5:0:4);
Readkey;
End;
Here is the code:
Uses crt;
Type
mang = array[1..255] of Integer;
Var
N, X, Y : Integer;
A : mang;
Procedure Nhap(Var A : mang; Var N : Integer);
Var
i : Integer;
Begin
Clrscr;
Write('So luong phan tu: ');
Readln(N);
For i := 1 to N do begin
Write('Nhap phan tu thu ', i, ': ');
Readln(A[I]);
end;
End;
Procedure Xuat(Var A: mang; Var N: Integer);
Var
i : Integer;
Begin
For i := 1 to N do write(A[i], ' ');
Writeln;
End;
Function KTMangTang(Var A : mang; Var N : Integer) : Boolean;
Var
i, j : Integer;
Var
kt : Boolean;
Begin
kt := True;
i := 0;
For i := 1 to N-1 do
for j := i+1 to N do
if A[i] > A[j] then
kt := False;
KTMangTang := kt;
End;
Function KTMangDX(Var A : mang; Var N : Integer) : Boolean;
Var
i, j : Integer;
Var
kt : Boolean;
Begin
kt := True;
i := 0;
For i := 1 to N do
for j := N-i downto 1 do
if A[i] <> A[j] then
kt := False;
KTMangDX := kt;
End;
begin
Nhap(A, N);
Xuat(A, N);
if KTMangTang then
Writeln('Mang tang')
else
Writeln('Mang khong tang');
if KTMangDX then
Writeln('Mang doi xung')
else
Writeln('Mang khong doi xung');
readln;
End.
The boolean value KTMangTang and KTMangDX were supposed to work but they returned these errors:
Free Pascal Compiler version 3.2.2 [2021/05/15] for i386
Copyright (c) 1993-2021 by Florian Klaempfl and others
Target OS: Win32 for i386
Compiling 34.pas
34.pas(53,4) Error: Wrong number of parameters specified for call to "KTMangTang"
34.pas(28,10) Error: Found declaration: KTMangTang(var mang;var SmallInt):Boolean;
34.pas(55,4) Error: Wrong number of parameters specified for call to "KTMangDX"
34.pas(39,10) Error: Found declaration: KTMangDX(var mang;var SmallInt):Boolean;
34.pas(58,4) Fatal: There were 4 errors compiling module, stopping
Fatal: Compilation aborted
Error: C:\FPC\3.2.2\bin\i386-Win32\ppc386.exe returned an error exitcode
I tried not to use the "kt" boolean variable but it returned other errors.
P/S: I use Visual Studio Code with Free Pascal Compiler (32 bit). If anyone knows how to install the 64 bit Free Pascal IDE, please help me.
You have declared KTMangTang and KTMangDX as functions taking two parameters and returning a BOOLEAN. You have called them with no parameters. This doesn’t work. The errors in the compilation specifically tell you this.
Actually i have this code below that is working fine to send webcam images over socket (ClientSocket > ServerSocket), before send, i'm saving the image to file . Then i want know if exists some solution to insert the capture inside of MemoryStream without need save to file before.
Any suggestion will welcome.
Thanks in advance.
Camera.pas
unit Camera;
interface
uses
Windows, Messages, SysUtils, Graphics, Controls, Dialogs, ExtCtrls,
Jpeg;
type
TCamera = class(TObject)
private
Parent: TPanel;
VideoHwnd: HWND;
procedure Resize(Sender: TObject);
public
constructor Create(Owner: TPanel);
destructor Destroy; override;
function TakePicture(FileName: string): boolean;
procedure SetSize;
procedure SetSource;
end;
implementation
const
WM_CAP_START = WM_USER;
WM_CAP_STOP = WM_CAP_START + 68;
WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10;
WM_CAP_DRIVER_DISCONNECT = WM_CAP_START + 11;
WM_CAP_SAVEDIB = WM_CAP_START + 25;
WM_CAP_DLG_VIDEOFORMAT = WM_CAP_START + 41;
WM_CAP_DLG_VIDEOSOURCE = WM_CAP_START + 42;
WM_CAP_SET_PREVIEW = WM_CAP_START + 50;
WM_CAP_SET_PREVIEWRATE = WM_CAP_START + 52;
WM_CAP_SET_SCALE = WM_CAP_START + 53;
WM_CAP_GRAB_FRAME = WM_CAP_START + 60;
WM_CAP_SEQUENCE = WM_CAP_START + 62;
WM_CAP_FILE_SET_CAPTURE_FILEA = WM_CAP_START + 20;
function capCreateCaptureWindowA(lpszWindowName: PCHAR; dwStyle: longint; x: integer; y: integer; nWidth: integer; nHeight: integer; ParentWin: HWND; nId: integer): HWND; stdcall; external 'AVICAP32.DLL';
constructor TCamera.Create(Owner: TPanel);
begin
try
VideoHwnd := capCreateCaptureWindowA('Camera', WS_CHILD or WS_VISIBLE, 0, 0, Owner.Width, Owner.Height, Owner.Handle, 0);
if (SendMessage(VideoHwnd, WM_CAP_DRIVER_CONNECT, 0, 0) <> 0) then
begin
SendMessage(VideoHwnd, WM_CAP_SET_PREVIEW, -1, 0);
SendMessage(VideoHwnd, WM_CAP_SET_PREVIEWRATE, 100, 0);
SendMessage(VideoHwnd, WM_CAP_SET_SCALE, -1, 0);
Parent := Owner;
Owner.OnResize := Resize;
end;
except
exit;
end;
end;
destructor TCamera.Destroy;
begin
if (VideoHwnd <> 0) then
begin
SendMessage(VideoHwnd, WM_CAP_DRIVER_DISCONNECT, 0, 0);
SetParent(VideoHwnd, 0);
SendMessage(VideoHwnd, WM_CLOSE, 0, 0);
end;
inherited;
end;
procedure TCamera.Resize(Sender: TObject);
begin
inherited;
if (VideoHwnd <> 0) then
begin
SetWindowPos(VideoHwnd, HWND_BOTTOM, 0, 0, Parent.Width, Parent.Height, SWP_NOMOVE or SWP_NOACTIVATE);
end;
end;
procedure TCamera.SetSize;
begin
SendMessage(VideoHwnd, WM_CAP_DLG_VIDEOFORMAT, 0, 0);
end;
procedure TCamera.SetSource;
begin
SendMessage(VideoHwnd, WM_CAP_DLG_VIDEOSOURCE, 0, 0);
end;
function StringToPAnsiChar(stringVar: string): PAnsiChar;
var
AnsString: AnsiString;
begin
Result := '';
try
if stringVar <> '' then
begin
AnsString := AnsiString(stringVar);
Result := PAnsiChar(PAnsiString(AnsString));
end;
except
end;
end;
function TCamera.TakePicture(FileName: string): boolean;
var
p: TPicture;
j: TJpegImage;
Q, k: integer;
begin
if (SendMessage(VideoHwnd, WM_CAP_GRAB_FRAME, 0, 0) <> 0) and (SendMessage(VideoHwnd, WM_CAP_SAVEDIB, wparam(0), lparam(StringToPAnsiChar(FileName))) <> 0) then
begin
SendMessage(VideoHwnd, WM_CAP_SET_PREVIEW, -1, 0);
p := TPicture.Create;
p.Bitmap.LoadFromFile(FileName);
j := TJpegImage.Create;
j.Assign(p.Bitmap);
val('100', Q, k);
j.CompressionQuality := Q;
j.SaveToFile(FileName);
p.Free;
j.Free;
result := true;
end
else
result := false;
end;
end.
Form1.pas
uses
Camera;
// ...
procedure TForm1.ClientSocketCamConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
Camera := TCamera.Create(Form1.Panel1);
end;
procedure TForm1.ClientSocketCamDisconnected(Sender: TObject; Socket: TCustomWinSocket);
begin
Camera.Destroy;
end;
procedure TForm1.ClientSocketCamError(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
ErrorCode := 0;
end;
procedure TForm1.ClientSocketCamRead(Sender: TObject; Socket: TCustomWinSocket);
var
s, FileName: string;
Stream: TMemoryStream;
begin
s := Socket.ReceiveText;
FileName := ExtractFilePath(Application.ExeName) + 'webcam.jpg';
if s = 'camoff' then
begin
Camera.Destroy;
Socket.SendText('endcam');
end;
if s = 'cam' then
begin
try
Camera.TakePicture(FileName);
Sleep(200);
Stream := TMemoryStream.Create;
if FileExists(FileName)
then
begin
Stream.LoadFromFile(FileName);
Stream.Position := 0;
Socket.SendText(inttostr(Stream.Size) + #0);
Socket.SendStream(Stream);
end;
finally
Stream.Free;
Exit;
end;
end;
end;
I'm having trouble with InputQuery/InputBox on Delphi XE2.
The input area is out of place (should be under text).
Is there a way to re-align it before making my own input form?
Thank you!
InputQuery() is not designed to be used in this manner. The prompt text is meant to be a short label displayed to the left of the text field (similar to TLabeledEdit). It is not designed to display instructions above the prompts, like you are attempting. This situation would be much better handled by simply creating your own custom Form using whatever controls and layouts you want. For instance, using TDateTimePicker for dates and times, TCheckBox or TRadioGroup to indicate repeats, etc.
However, that being said, InputQuery() is implemented using a custom VCL TForm, so it is technically possible to accomplish what you are trying to achieve. You can use the TScreen.OnActiveFormChange event to gain access to the Form object when it becomes visible, and then you can manipulate it however you want. For example:
procedure TMyForm.ActiveFormChanged(Sender: TObject);
var
Form: TCustomForm;
Prompt: TLabel;
Edit: TEdit;
Ctrl: TControl;
I, J, ButtonTop: Integer;
begin
Form := Screen.ActiveCustomForm;
if (Form = nil) or (Form.ClassName <> 'TInputQueryForm') then Exit;
for I := 0 to Form.ControlCount-1 do
begin
Ctrl := Form.Controls[i];
if Ctrl is TLabel then
begin
Prompt := TLabel(Ctrl);
end
else if Ctrl is TEdit then
begin
Edit := TEdit(Ctrl);
end;
end;
Edit.SetBounds(Prompt.Left, Prompt.Top + Prompt.Height + 5, Prompt.Width, Edit.Height);
Form.ClientWidth := (Edit.Left * 2) + Edit.Width;
ButtonTop := Edit.Top + Edit.Height + 15;
J := 0;
for I := 0 to Form.ControlCount-1 do
begin
Ctrl := Form.Controls[i];
if Ctrl is TButton then
begin
Ctrl.SetBounds(Form.ClientWidth - ((Ctrl.Width + 15) * (2-J)), ButtonTop, Ctrl.Width, Ctrl.Height);
Form.ClientHeight := Ctrl.Top + Ctrl.Height + 13;
Inc(J);
end;
end;
end;
procedure TMyForm.DoSomething;
var
value: string;
begin
Screen.OnActiveFormChange := ActiveFormChanged;
try
InputQuery('Enter New Schedule', 'Format: <Second> <Minute> <Hour> <Day_of_the_Month> <Month_of_the_Year> <Day_of_the_Week> <Year>.'#10'Use * for repeating cycles. ex: 0 0 7 * * * * (trigger at 7AM everyday)', value);
finally
Screen.OnActiveFormChange := nil;
end;
end;
Alternatively:
class procedure TScreenEvents.ActiveFormChanged(Sender: TObject);
var
Form: TCustomForm;
Instructions: TLabel;
Ctrl: TControl;
I, J, K, Offset: Integer;
begin
Form := Screen.ActiveCustomForm;
if (Form = nil) or (Form.ClassName <> 'TInputQueryForm') then Exit;
for I := 0 to Form.ControlCount-1 do
begin
Ctrl := Form.Controls[I];
if Ctrl is TLabel then
begin
Instructions := TLabel.Create(Form);
Instructions.Parent := Form;
Instructions.Caption := 'Format: <Second> <Minute> <Hour> <Day_of_the_Month> <Month_of_the_Year> <Day_of_the_Week> <Year>.'#10'Use * for repeating cycles. ex: 0 0 7 * * * * (trigger at 7AM everyday)';
Instructions.SetBounds(Ctrl.Left, Ctrl.Top, Instructions.Width, Instructions.Height);
Offset := Instructions.Top + Instructions.Height + 5;
Form.ClientWidth := Instructions.Width + (Instructions.Left * 2);
K := 0;
for J := 0 to Form.ControlCount-1 do
begin
Ctrl := Form.Controls[J];
if Ctrl <> Instructions then
begin
Ctrl.Top := Ctrl.Top + Offset;
if Ctrl is TEdit then
begin
Ctrl.Width := (Form.ClientWidth - Ctrl.Left - Instructions.Left);
end
else if Ctrl is TButton then
begin
Ctrl.Left := (Form.ClientWidth - (Ctrl.Width + 5) * (2-K));
Inc(K);
end;
end;
end;
Form.ClientHeight := Form.ClientHeight + Offset;
Break;
end;
end;
end;
procedure TMyForm.DoSomething;
var
value: string;
begin
Screen.OnActiveFormChange := ActiveFormChanged;
try
InputQuery('Enter New Schedule', 'Value', value);
finally
Screen.OnActiveFormChange := nil;
end;
end;
In another question near this, i get the answer to get modal forms to keep inside a workarea inside the mainform.
The way i can accomplish that (thanks to David again) is catching WMSizing, WMMoving, WMGetMaxMinInfo, and for my porpuose WMShowwindow messages.
I am not closed to messages handling and i think it is likely the way i manage messages the cause that i am not getting the result i needed.
All the forms in my application are modal. But you can open a lot in the same execution thread. (Mainform, form1, form2, form3... formN).
All form(1..N) move inside a workarea in my mainform. Maximize, restore, size, move... all between limits of that workarea.
But i cannot manage how to minimize the whole application from then click on active modal form minimize button, and from click on taskbar button.
The application will be used in XP and W7... i am developing in DelphiXE.
The project can be downloaded from here (Project files - Mainform, panel, button, SecondaryForm, unit, nothing more), just to see that i try all the suggestions i found before asking here.
This is the source code of the original unit that keeps the modal forms inside the workarea.
unit uFormularios;
interface
uses Classes, SysUtils, Windows, Messages, Forms, DBGrids, StdCtrls, Menus, Graphics, ComCtrls, Math;
type
TForm_en_ventana = class(TForm)
private
inicializada: boolean;
bCentrada : boolean;
bMaximizada : boolean;
ancho_original: integer;
alto_original : integer;
procedure WMShowWindow(var Message: TWMShowWindow); message WM_SHOWWINDOW;
procedure WMSizing(var msg: TMessage); message WM_SIZING;
procedure WMMoving(Var msg: TMessage); message WM_MOVING;
procedure WMGetMinMaxInfo(Var msg: TWMGetMinMaxInfo); message WM_GETMINMAXINFO;
public
constructor Create(AOwner: TComponent); override;
property centrada: boolean read bCentrada write bCentrada;
property maximizada: boolean read bMaximizada write bMaximizada;
end;
procedure MaximizarFormulario(var F; MaximaAltura: integer = 0; MaximoAncho: integer = 0; Centrado: boolean = TRUE);
procedure InicializarVentanaTrabajo(const izq, der, arr, aba: integer);
var
ESPACIO_DE_TRABAJO, VENTANA_DE_TRABAJO: TRect;
implementation
constructor TForm_en_ventana.Create(AOwner: TComponent);
begin
inherited;
centrada := TRUE;
maximizada := false;
inicializada := false;
end;
Procedure TForm_en_ventana.WMGetMinMaxInfo(Var msg: TWMGetMinMaxInfo);
begin
inherited;
with msg.MinMaxInfo^.ptMaxPosition do
begin
x := VENTANA_DE_TRABAJO.Left;
y := VENTANA_DE_TRABAJO.Top;
end;
with msg.MinMaxInfo^.ptMaxSize do
begin
x := VENTANA_DE_TRABAJO.Right - VENTANA_DE_TRABAJO.Left;
y := VENTANA_DE_TRABAJO.Bottom - VENTANA_DE_TRABAJO.Top;
end;
with msg.MinMaxInfo^.ptMaxTrackSize do
begin
x := VENTANA_DE_TRABAJO.Right - VENTANA_DE_TRABAJO.Left;
y := VENTANA_DE_TRABAJO.Bottom - VENTANA_DE_TRABAJO.Top;
end;
with msg.MinMaxInfo^.ptMinTrackSize do
begin
x := ancho_original;
y := alto_original;
end;
end;
procedure TForm_en_ventana.WMSizing(var msg: TMessage);
var
R: PRect;
begin
R := PRect(msg.LParam);
R.Left := Max(R.Left, VENTANA_DE_TRABAJO.Left);
R.Right := Min(R.Right, VENTANA_DE_TRABAJO.Right);
R.Top := Max(R.Top, VENTANA_DE_TRABAJO.Top);
R.Bottom := Min(R.Bottom, VENTANA_DE_TRABAJO.Bottom);
Caption := 'Ancho: ' + inttostr(ancho_original) + ' - Alto: ' + inttostr(alto_original);
end;
procedure TForm_en_ventana.WMMoving(var msg: TMessage);
var
R : PRect;
dx, dy: integer;
begin
R := PRect(msg.LParam);
dx := 0;
dy := 0;
if R.Left < VENTANA_DE_TRABAJO.Left then
dx := VENTANA_DE_TRABAJO.Left - R.Left;
if R.Right > VENTANA_DE_TRABAJO.Right then
dx := VENTANA_DE_TRABAJO.Right - R.Right;
if R.Top < VENTANA_DE_TRABAJO.Top then
dy := VENTANA_DE_TRABAJO.Top - R.Top;
if R.Bottom > VENTANA_DE_TRABAJO.Bottom then
dy := VENTANA_DE_TRABAJO.Bottom - R.Bottom;
OffsetRect(R^, dx, dy);
end;
procedure TForm_en_ventana.WMShowWindow(var Message: TWMShowWindow);
begin
if inicializada then
Exit;
inicializada := TRUE;
ancho_original := Width;
alto_original := Height;
Constraints.MinHeight := Height;
Constraints.MinWidth := Width;
if centrada then
begin
Left := (((VENTANA_DE_TRABAJO.Right - VENTANA_DE_TRABAJO.Left) - Width) div 2) + VENTANA_DE_TRABAJO.Left;
Top := (((VENTANA_DE_TRABAJO.Bottom - VENTANA_DE_TRABAJO.Top) - Height) div 2) + VENTANA_DE_TRABAJO.Top;
end;
if maximizada then
SendMessage(Handle, WM_SYSCOMMAND, SC_MAXIMIZE, 0);
end;
procedure InicializarVentanaTrabajo(const izq, der, arr, aba: integer);
begin
VENTANA_DE_TRABAJO.Left := izq;
VENTANA_DE_TRABAJO.Right := der;
VENTANA_DE_TRABAJO.Top := arr;
VENTANA_DE_TRABAJO.Bottom := aba;
end;
procedure MaximizarFormulario(var F; MaximaAltura: integer = 0; MaximoAncho: integer = 0; Centrado: boolean = TRUE);
begin
LockWindowUpdate(TForm(F).Handle);
TForm(F).Left := ESPACIO_DE_TRABAJO.Left;
if MaximoAncho = 0 then
TForm(F).Width := ESPACIO_DE_TRABAJO.Right
else
begin
if ESPACIO_DE_TRABAJO.Right < MaximoAncho then
TForm(F).Width := ESPACIO_DE_TRABAJO.Right
else
TForm(F).Width := MaximoAncho;
end;
TForm(F).Top := ESPACIO_DE_TRABAJO.Top;
if MaximaAltura = 0 then
TForm(F).Height := ESPACIO_DE_TRABAJO.Bottom
else
begin
if ESPACIO_DE_TRABAJO.Bottom < MaximaAltura then
TForm(F).Height := ESPACIO_DE_TRABAJO.Bottom
else
TForm(F).Height := MaximaAltura;
end;
if ((MaximoAncho <> 0) or (MaximaAltura <> 0)) and (Centrado) then
begin
TForm(F).Left := (ESPACIO_DE_TRABAJO.Right - TForm(F).Width) div 2;
TForm(F).Top := (ESPACIO_DE_TRABAJO.Bottom - TForm(F).Height) div 2;
end;
LockWindowUpdate(0);
end;
initialization
SystemParametersInfo(SPI_GETWORKAREA, 0, #ESPACIO_DE_TRABAJO, 0);
VENTANA_DE_TRABAJO := ESPACIO_DE_TRABAJO;
end.
Thanks to anybody who can help me!
I needed this too, and I tried the other answer but it's not working. Fortunately I managed to make it work, like this:
procedure TFoodsForm.WMSysCommand(var Msg: TWMSysCommand);
begin
if (fsModal in FormState) and (Msg.CmdType and $FFF0 = SC_MINIMIZE)
then Application.MainForm.WindowState:= wsMinimized
else inherited;
end;
Simply catch the Minimize and Restore messages in the Modal Form and do this ...
procedure TTheModalForm.WMSysCommand(var Msg: TWMSysCommand);
begin
if (fsModal in FormState) or not Application.MainForm.Visible then
begin
case Msg.CmdType of
SC_MINIMIZE:
begin
ShowWindow(Application.Handle, SW_SHOWMINNOACTIVE);
end;
SC_RESTORE:
begin
ShowWindow(Application.Handle, SW_SHOWNORMAL);
inherited;
end;
else
inherited;
end;
end
else
inherited;
end;
Thank you, JFGravel! This worked great for me, but I could never get the SC_RESTORE to get caught here, but restore works fine without, so here's my short version:
if (Message.CmdType and $FFF0) = SC_MINIMIZE then
ShowWindow(Application.Handle, SW_SHOWMINNOACTIVE)
else
inherited;